├── .github └── workflows │ └── workflow.yml ├── .gitignore ├── .ocp-indent ├── CODEOWNERS ├── Changelog.md ├── LICENSE.md ├── Makefile ├── README.md ├── bench ├── Makefile ├── bench.ml ├── bench.proto ├── dune ├── enum.proto ├── enum_list.proto ├── float.proto ├── float_list.proto ├── int64.proto ├── int64_list.proto ├── perf.data ├── plugin │ └── dune ├── protoc │ └── dune ├── string.proto └── string_list.proto ├── conf-protoc.opam ├── dune ├── dune-project ├── examples ├── echo │ ├── dune │ ├── echo.proto │ └── test.ml ├── echo_deriving │ ├── dune │ ├── echo.proto │ ├── google_types_deriving │ │ └── dune │ └── test.ml └── extensions │ ├── dune │ ├── extensions.proto │ └── test.ml ├── ocaml-protoc-plugin.opam ├── src ├── google_types │ └── dune ├── ocaml_protoc_plugin │ ├── deserialize.ml │ ├── deserialize.mli │ ├── dune │ ├── extensions.ml │ ├── extensions.mli │ ├── field.ml │ ├── infix.ml │ ├── ocaml_protoc_plugin.ml │ ├── reader.ml │ ├── reader.mli │ ├── result.ml │ ├── result.mli │ ├── runtime.ml │ ├── serialize.ml │ ├── service.ml │ ├── spec.ml │ ├── writer.ml │ └── writer.mli ├── plugin │ ├── code.ml │ ├── dune │ ├── emit.ml │ ├── emit.mli │ ├── names.ml │ ├── option.ml │ ├── parameters.ml │ ├── parse.ml │ ├── protoc_gen_ocaml.ml │ ├── scope.ml │ ├── scope.mli │ ├── types.ml │ └── types.mli └── spec │ ├── descriptor.ml │ ├── dune │ ├── options.ml │ ├── options.proto │ └── plugin.ml └── test ├── basic.proto ├── dune ├── empty.proto ├── enum.proto ├── enum_test.ml ├── extensions.proto ├── extensions_test.ml ├── 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 ├── large.proto ├── large_test.ml ├── mangle_names.proto ├── mangle_names_test.ml ├── map.proto ├── map_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 ├── protocol.proto ├── protocol_test.ml ├── recursive.proto ├── recursive_test.ml ├── repeated.proto ├── repeated_test.ml ├── service.proto ├── service_empty_package.proto ├── service_rpc_clash.proto ├── service_test.ml ├── singleton_record.proto ├── singleton_record_test.ml └── test_lib.ml /.github/workflows/workflow.yml: -------------------------------------------------------------------------------- 1 | name: Main workflow 2 | 3 | on: 4 | - pull_request 5 | - push 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.08.0 17 | 18 | runs-on: ${{ matrix.os }} 19 | 20 | steps: 21 | - name: Checkout code 22 | uses: actions/checkout@v3 23 | 24 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 25 | uses: ocaml/setup-ocaml@v2 26 | with: 27 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 28 | 29 | - run: opam pin . --no-action 30 | - run: opam depext conf-protoc --yes --with-doc --with-test 31 | - run: opam install . --deps-only --with-doc --with-test 32 | - run: opam exec -- dune build 33 | - run: opam exec -- dune runtest 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /_build/ 2 | /_opam/ 3 | /*.install 4 | .merlin 5 | node_modules 6 | lib 7 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | JaneStreet 2 | with=0 3 | #match_clause=4 4 | # max_indent=2 5 | -------------------------------------------------------------------------------- /CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @issuu/backend 2 | -------------------------------------------------------------------------------- /Changelog.md: -------------------------------------------------------------------------------- 1 | ## 5.0.0: Unreleased 2 | - [ ] Merge messages when receiving multiple messages for the same 3 | field (#57) 4 | - [ ] Optimize serialization and deserialization (#55) 5 | - [x] Fix upper case handling in name mangling and apply name mangling 6 | for serivce records (#54) (thanks @crackcomm) 7 | - [x] Fix bug in name resolution leading to uncompilable code (#53) 8 | 9 | 10 | ## 4.5.0: 2023-06-16 11 | - [x] Add more fields in generated service structs to make it easier 12 | to extract service endpoint names for gRPC (#50) 13 | - [x] Remove buckescript packaging support (#45) 14 | 15 | ## 4.4.0: 2023-03-13 16 | - [x] Emit modules for service endpoints with request/reply and gRPC 17 | endpoint name (thanks @Nymphium) 18 | - [x] Support importing from proto files with `-` in their name. 19 | 20 | ## 4.3.1: 2022-09-12 21 | - [x] Fix serialization/deserialization on big endian architectures 22 | - [x] Update tests for proto3 optional fields 23 | - [x] Remove dependency on dune-configurator 24 | 25 | 26 | ## 4.3.0: 2022-09-09 27 | - [x] Use pkg-config to locate google well known types (thanks @vprevosto) 28 | - [x] Support proto3 optional fields 29 | - [x] Map proto3 optional fields into option types 30 | 31 | ## 4.2.0: 2021-01-31 32 | - [x] Do not serialize field values when the same as the default 33 | attribute. 34 | - [x] Fix bug when uint32/64 where values are converted to negative 35 | integers if high bit is set. 36 | - [x] Fix bug which prevented specification of multiple opens (thanks @rauanmayemir) 37 | 38 | ## 4.1.0: 2020-10-31 39 | - [x] Fix bug with Proto2 default integer arguments for Int32 and 40 | Int64 types 41 | - [x] Add function to construct messages with default values 42 | - [x] Add missing includes for google well known types 43 | 44 | ## 4.0.0: 2020-05-10 45 | - [x] Move userdefined opens to beginning of autogenerated files, to 46 | allow using new google types 47 | - [*] Wrap google types (protofiles using googles well known types 48 | will need to add `open=Google_types` to the list of compilation options 49 | - [x] Disable warning 33 (unused opens) for user provided opens 50 | 51 | ## 3.0.0: 2020-01-06 52 | - [x] Add custom option to mangle names (modules, fields and enums) to 53 | more Ocaml idiomatic names (snake_cased) 54 | - [x] Change type of deserialize error type to be an lower bound polymorphic variant 55 | - [x] Rewrite type mapping to ensure that no name clashes can exist. 56 | - [x] Fix bug in nested cursive types referencing wrong types 57 | - [x] Add custom options, so options to ocaml\_protoc\_plugin can be 58 | embedded in .proto files 59 | - [x] Support extensions 60 | - [x] Allow use of message name Ocaml\_protoc\_plugin 61 | - [x] `*`Do not treat oneof fields as required, adding a `not_set variant 62 | to all oneofs. 63 | - [x] Avoid name clash with imported .proto files 64 | - [x] Avoid eager evaluation of members of recursivbe modules to fix 65 | bug triggered in bucklescript - @wokalski 66 | 67 | ## 2.0.0: 2019-10-20 68 | - [x] Add examples 69 | - [x] *Oneofs with only one element should not be a variant type 70 | - [x] Add test when including proto files which defines the same package 71 | - [x] Add google well know types (library `ocaml-protoc-plugin.google_types`). 72 | - [x] *Move module to ocaml-protoc-plugin 73 | - [x] Optimize deserialization of large nested structures 74 | - [x] Provide pretty_printers aka deriving_show for `Result.error` and `Field.t` 75 | - [x] Fix stack overflow when deserializing big nested structures 76 | - [x] *Add option to not wrap single field type in records 77 | - [x] Refactor type emitter to closely follow spec 78 | 79 | ## 1.0.0: 2019-10-12 80 | - [x] Support enum aliasing 81 | - [x] Avoid name clash with on 'name' 82 | - [x] Fix code generation when argument contains a path 83 | - [x] Refactor internal types to make serialization and 84 | deserialization type spec symmetrical. 85 | - [x] Optimize deserialization for messages with max_id < 1024 86 | - [x] Dont depend on Base in runtime 87 | - [x] Slim runtime dependencies: Remove need for base, ocplib-endian 88 | and ppx_let 89 | - [x] Honour [packed=...] flag. 90 | - [x] Make fixed scalar types default to int32 and int64 91 | - [x] Support proto2 specification 92 | - [x] Add options to switch between int64|int32 and int 93 | - [x] Fix name clash problem with special enum names 94 | - [x] Refactor serializaton and deserialization to simplify emitted code 95 | - [x] Eagerly evaluate serialization (for speed). 96 | 97 | ## 0.9: 2019-09-25 98 | - [x] Initial Release 99 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Apache License 2 | ============== 3 | 4 | _Version 2.0, January 2004_ 5 | _<>_ 6 | 7 | ### Terms and Conditions for use, reproduction, and distribution 8 | 9 | #### 1. Definitions 10 | 11 | “License” shall mean the terms and conditions for use, reproduction, and 12 | distribution as defined by Sections 1 through 9 of this document. 13 | 14 | “Licensor” shall mean the copyright owner or entity authorized by the copyright 15 | owner that is granting the License. 16 | 17 | “Legal Entity” shall mean the union of the acting entity and all other entities 18 | that control, are controlled by, or are under common control with that entity. 19 | For the purposes of this definition, “control” means **(i)** the power, direct or 20 | indirect, to cause the direction or management of such entity, whether by 21 | contract or otherwise, or **(ii)** ownership of fifty percent (50%) or more of the 22 | outstanding shares, or **(iii)** beneficial ownership of such entity. 23 | 24 | “You” (or “Your”) shall mean an individual or Legal Entity exercising 25 | permissions granted by this License. 26 | 27 | “Source” form shall mean the preferred form for making modifications, including 28 | but not limited to software source code, documentation source, and configuration 29 | files. 30 | 31 | “Object” form shall mean any form resulting from mechanical transformation or 32 | translation of a Source form, including but not limited to compiled object code, 33 | generated documentation, and conversions to other media types. 34 | 35 | “Work” shall mean the work of authorship, whether in Source or Object form, made 36 | available under the License, as indicated by a copyright notice that is included 37 | in or attached to the work (an example is provided in the Appendix below). 38 | 39 | “Derivative Works” shall mean any work, whether in Source or Object form, that 40 | is based on (or derived from) the Work and for which the editorial revisions, 41 | annotations, elaborations, or other modifications represent, as a whole, an 42 | original work of authorship. For the purposes of this License, Derivative Works 43 | shall not include works that remain separable from, or merely link (or bind by 44 | name) to the interfaces of, the Work and Derivative Works thereof. 45 | 46 | “Contribution” shall mean any work of authorship, including the original version 47 | of the Work and any modifications or additions to that Work or Derivative Works 48 | thereof, that is intentionally submitted to Licensor for inclusion in the Work 49 | by the copyright owner or by an individual or Legal Entity authorized to submit 50 | on behalf of the copyright owner. For the purposes of this definition, 51 | “submitted” means any form of electronic, verbal, or written communication sent 52 | to the Licensor or its representatives, including but not limited to 53 | communication on electronic mailing lists, source code control systems, and 54 | issue tracking systems that are managed by, or on behalf of, the Licensor for 55 | the purpose of discussing and improving the Work, but excluding communication 56 | that is conspicuously marked or otherwise designated in writing by the copyright 57 | owner as “Not a Contribution.” 58 | 59 | “Contributor” shall mean Licensor and any individual or Legal Entity on behalf 60 | of whom a Contribution has been received by Licensor and subsequently 61 | incorporated within the Work. 62 | 63 | #### 2. Grant of Copyright License 64 | 65 | Subject to the terms and conditions of this License, each Contributor hereby 66 | grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, 67 | irrevocable copyright license to reproduce, prepare Derivative Works of, 68 | publicly display, publicly perform, sublicense, and distribute the Work and such 69 | Derivative Works in Source or Object form. 70 | 71 | #### 3. Grant of Patent License 72 | 73 | Subject to the terms and conditions of this License, each Contributor hereby 74 | grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, 75 | irrevocable (except as stated in this section) patent license to make, have 76 | made, use, offer to sell, sell, import, and otherwise transfer the Work, where 77 | such license applies only to those patent claims licensable by such Contributor 78 | that are necessarily infringed by their Contribution(s) alone or by combination 79 | of their Contribution(s) with the Work to which such Contribution(s) was 80 | submitted. If You institute patent litigation against any entity (including a 81 | cross-claim or counterclaim in a lawsuit) alleging that the Work or a 82 | Contribution incorporated within the Work constitutes direct or contributory 83 | patent infringement, then any patent licenses granted to You under this License 84 | for that Work shall terminate as of the date such litigation is filed. 85 | 86 | #### 4. Redistribution 87 | 88 | You may reproduce and distribute copies of the Work or Derivative Works thereof 89 | in any medium, with or without modifications, and in Source or Object form, 90 | provided that You meet the following conditions: 91 | 92 | * **(a)** You must give any other recipients of the Work or Derivative Works a copy of 93 | this License; and 94 | * **(b)** You must cause any modified files to carry prominent notices stating that You 95 | changed the files; and 96 | * **(c)** You must retain, in the Source form of any Derivative Works that You distribute, 97 | all copyright, patent, trademark, and attribution notices from the Source form 98 | of the Work, excluding those notices that do not pertain to any part of the 99 | Derivative Works; and 100 | * **(d)** If the Work includes a “NOTICE” text file as part of its distribution, then any 101 | Derivative Works that You distribute must include a readable copy of the 102 | attribution notices contained within such NOTICE file, excluding those notices 103 | that do not pertain to any part of the Derivative Works, in at least one of the 104 | following places: within a NOTICE text file distributed as part of the 105 | Derivative Works; within the Source form or documentation, if provided along 106 | with the Derivative Works; or, within a display generated by the Derivative 107 | Works, if and wherever such third-party notices normally appear. The contents of 108 | the NOTICE file are for informational purposes only and do not modify the 109 | License. You may add Your own attribution notices within Derivative Works that 110 | You distribute, alongside or as an addendum to the NOTICE text from the Work, 111 | provided that such additional attribution notices cannot be construed as 112 | modifying the License. 113 | 114 | You may add Your own copyright statement to Your modifications and may provide 115 | additional or different license terms and conditions for use, reproduction, or 116 | distribution of Your modifications, or for any such Derivative Works as a whole, 117 | provided Your use, reproduction, and distribution of the Work otherwise complies 118 | with the conditions stated in this License. 119 | 120 | #### 5. Submission of Contributions 121 | 122 | Unless You explicitly state otherwise, any Contribution intentionally submitted 123 | for inclusion in the Work by You to the Licensor shall be under the terms and 124 | conditions of this License, without any additional terms or conditions. 125 | Notwithstanding the above, nothing herein shall supersede or modify the terms of 126 | any separate license agreement you may have executed with Licensor regarding 127 | such Contributions. 128 | 129 | #### 6. Trademarks 130 | 131 | This License does not grant permission to use the trade names, trademarks, 132 | service marks, or product names of the Licensor, except as required for 133 | reasonable and customary use in describing the origin of the Work and 134 | reproducing the content of the NOTICE file. 135 | 136 | #### 7. Disclaimer of Warranty 137 | 138 | Unless required by applicable law or agreed to in writing, Licensor provides the 139 | Work (and each Contributor provides its Contributions) on an “AS IS” BASIS, 140 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, 141 | including, without limitation, any warranties or conditions of TITLE, 142 | NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are 143 | solely responsible for determining the appropriateness of using or 144 | redistributing the Work and assume any risks associated with Your exercise of 145 | permissions under this License. 146 | 147 | #### 8. Limitation of Liability 148 | 149 | In no event and under no legal theory, whether in tort (including negligence), 150 | contract, or otherwise, unless required by applicable law (such as deliberate 151 | and grossly negligent acts) or agreed to in writing, shall any Contributor be 152 | liable to You for damages, including any direct, indirect, special, incidental, 153 | or consequential damages of any character arising as a result of this License or 154 | out of the use or inability to use the Work (including but not limited to 155 | damages for loss of goodwill, work stoppage, computer failure or malfunction, or 156 | any and all other commercial damages or losses), even if such Contributor has 157 | been advised of the possibility of such damages. 158 | 159 | #### 9. Accepting Warranty or Additional Liability 160 | 161 | While redistributing the Work or Derivative Works thereof, You may choose to 162 | offer, and charge a fee for, acceptance of support, warranty, indemnity, or 163 | other liability obligations and/or rights consistent with this License. However, 164 | in accepting such obligations, You may act only on Your own behalf and on Your 165 | sole responsibility, not on behalf of any other Contributor, and only if You 166 | agree to indemnify, defend, and hold each Contributor harmless for any liability 167 | incurred by, or claims asserted against, such Contributor by reason of your 168 | accepting any such warranty or additional liability. 169 | 170 | _END OF TERMS AND CONDITIONS_ 171 | 172 | ### APPENDIX: How to apply the Apache License to your work 173 | 174 | To apply the Apache License to your work, attach the following boilerplate 175 | notice, with the fields enclosed by brackets `[]` replaced with your own 176 | identifying information. (Don't include the brackets!) The text should be 177 | enclosed in the appropriate comment syntax for the file format. We also 178 | recommend that a file or class name and description of purpose be included on 179 | the same “printed page” as the copyright notice for easier identification within 180 | third-party archives. 181 | 182 | Copyright [yyyy] [name of copyright owner] 183 | 184 | Licensed under the Apache License, Version 2.0 (the "License"); 185 | you may not use this file except in compliance with the License. 186 | You may obtain a copy of the License at 187 | 188 | http://www.apache.org/licenses/LICENSE-2.0 189 | 190 | Unless required by applicable law or agreed to in writing, software 191 | distributed under the License is distributed on an "AS IS" BASIS, 192 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 193 | See the License for the specific language governing permissions and 194 | limitations under the License. 195 | 196 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | GOOGLE_INCLUDE=$(shell pkg-config protobuf --variable=includedir)/google/protobuf 2 | 3 | .PHONY: build 4 | build: ## Build 5 | @dune build @install 6 | 7 | .PHONY: clean 8 | clean: ## Clean 9 | @dune clean 10 | 11 | .PHONY: test 12 | test: build 13 | test: ## Run tests 14 | @dune runtest --force 15 | 16 | .PHONY: install 17 | install: build ## Install 18 | @dune install 19 | 20 | .PHONY: uninstall 21 | uninstall: build ## uninstall 22 | @dune uninstall 23 | 24 | %: %.proto 25 | protoc --experimental_allow_proto3_optional -I $(dir $<) $< -o/dev/stdout | protoc --experimental_allow_proto3_optional --decode google.protobuf.FileDescriptorSet $(GOOGLE_INCLUDE)/descriptor.proto 26 | 27 | PLUGIN = _build/default/src/plugin/protoc_gen_ocaml.exe 28 | $(PLUGIN): force 29 | dune build src/plugin/protoc_gen_ocaml.exe 30 | 31 | src/spec/descriptor.ml: $(PLUGIN) 32 | protoc "--plugin=protoc-gen-ocaml=$(PLUGIN)" \ 33 | -I /usr/include \ 34 | --ocaml_out=src/spec/. \ 35 | $(GOOGLE_INCLUDE)/descriptor.proto 36 | 37 | src/spec/plugin.ml: $(PLUGIN) 38 | protoc "--plugin=protoc-gen-ocaml=$(PLUGIN)" \ 39 | -I /usr/include \ 40 | --ocaml_out=src/spec/. \ 41 | $(GOOGLE_INCLUDE)/compiler/plugin.proto 42 | 43 | src/spec/options.ml: $(PLUGIN) 44 | protoc "--plugin=protoc-gen-ocaml=$(PLUGIN)" \ 45 | -I src/spec -I /usr/include \ 46 | --ocaml_out=src/spec/. \ 47 | src/spec/options.proto 48 | .PHONY: bootstrap 49 | bootstrap: src/spec/descriptor.ml src/spec/plugin.ml src/spec/options.ml ## Regenerate files used for generation 50 | 51 | %.ml: %.proto 52 | protoc -I $(shell pkg-config protobuf --variable=includedir) -I $(dir $<) --plugin=protoc-gen-ocaml=_build/default/src/plugin/protoc_gen_ocaml.exe \ 53 | --ocaml_out=$(dir $@). $< 54 | 55 | 56 | .PHONY: doc 57 | doc: ## Build documentation 58 | dune build @doc 59 | 60 | gh-pages: doc ## Publish documentation 61 | git clone `git config --get remote.origin.url` .gh-pages --reference . 62 | git -C .gh-pages checkout --orphan gh-pages 63 | git -C .gh-pages reset 64 | git -C .gh-pages clean -dxf 65 | cp -r _build/default/_doc/_html/* .gh-pages 66 | git -C .gh-pages add . 67 | git -C .gh-pages config user.email 'docs@ocaml-protoc-plugin' 68 | git -C .gh-pages commit -m "Update documentation" 69 | git -C .gh-pages push origin gh-pages -f 70 | rm -rf .gh-pages 71 | 72 | .PHONY: bench 73 | bench: ## Run benchmark to compare with ocaml-protoc 74 | dune exec bench/bench.exe 75 | 76 | .PHONY: force 77 | force: 78 | 79 | .PHONY: help 80 | help: ## Show this help 81 | @grep -h -E '^[.a-zA-Z_-]+:.*## .*$$' $(MAKEFILE_LIST) | awk 'BEGIN {FS = ":.*## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}' 82 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Active development moved 2 | This repository contains original version of `ocaml-protoc-plugin`. However, active development of this libary has moved to [andersfugmann/ocaml-protoc-plugin](https://github.com/andersfugmann/ocaml-protoc-plugin). Consider using [andersfugmann/ocaml-protoc-plugin](https://github.com/andersfugmann/ocaml-protoc-plugin) when filing new isses and PR's against latest versions of ocaml-protoc-plugin. 3 | 4 | # Ocaml protoc plugin 5 | [![Main workflow](https://github.com/issuu/ocaml-protoc-plugin/actions/workflows/workflow.yml/badge.svg)](https://github.com/issuu/ocaml-protoc-plugin/actions/workflows/workflow.yml) 6 | 7 | The goal of Ocaml protoc plugin is to create an up to date plugin for 8 | the google protobuf compiler (`protoc`) to generate Ocaml types and 9 | serialization and de-serialization function from a `.proto` file. 10 | 11 | The main features include: 12 | * Messages are mapped to idiomatic OCaml types, using modules 13 | * Support service descriptions 14 | * proto3 compliant 15 | * proto2 compliant 16 | * Supports includes 17 | * Supports proto2 extensions 18 | * Builtin support for google well known types 19 | * Configurable annotations for all generated types 20 | 21 | 22 | ## Comparison with other OCaml protobuf handlers. 23 | 24 | | Feature | ocaml-protoc | ocaml-pb | ocaml-protoc-plugin | 25 | | ------- | ------------ | --------------- | ------------------- | 26 | | Ocaml types | Supported | Defined runtime[^1] | Supported | 27 | | Service endpoints | Supported | N/A | Supported | 28 | | proto3 | Supported[^3]| Supported | Supported | 29 | | proto2 | Supported[^3]| Supported | Supported | 30 | | proto2 extends | Ignored | Supported | Supported | 31 | | proto2 groups | Ignored | ? | Not supported[^2] | 32 | 33 | [^1] Ocaml-bp has a sister project `Ocaml-bp-plugin` which emit 34 | Ocaml-pb definitions from a `.proto`. The plugin parses files are proto2 35 | Ocaml type definitions (all fields are option types), and repeated 36 | fields are not packed by default. 37 | 38 | [^2] Groups has been deprecated by google and should not be used. 39 | 40 | [^3] `ocaml_protoc` will always transmit all fields that are not 41 | marked optional, and does not *strictly* comply to the protobuf 42 | specification. 43 | 44 | 45 | ## Types 46 | Basic types are mapped trivially to Ocaml types: 47 | 48 | Primitive types: 49 | 50 | | Protobuf Type | Ocaml type | 51 | | ------------- | ---------- | 52 | | int32, int64, uint32, uint64, sint32, sint64 | int[^3] | 53 | | fixed64, sfixed64, fixed32, sfixed32 | int32, int64[^3] | 54 | | bool | bool | 55 | | float, double | float | 56 | | string | string | 57 | | bytes | bytes | 58 | 59 | [^3] The plugin supports changing the type for scalar types to 60 | int/int64/int32. See options section below. 61 | 62 | A message declaration is compiled to a module with a record type 63 | `t`. However, messages without any fields are mapped to unit. 64 | 65 | Packages are trivially mapped to modules. 66 | Included proto files (`.proto`) are assumed to have been compiled 67 | to `.ml`, and types in included proto files are referenced by 68 | their fill name. 69 | 70 | Compound types are mapped like: 71 | 72 | | Protobuf Type | Ocaml type | 73 | | ------------- | ---------- | 74 | | oneof | Polymorphic variants: `[ Field1 of fieldtype1, Field1 of fieldtype2 ]` | 75 | | repeated 'a | 'a list | 76 | | message | message option | 77 | | enum | Abstract data types: `` Enum1, Enum2, Enum3 `` | 78 | | map<'a, 'b> | ('a * 'b) list | 79 | 80 | 81 | ## Proto2 type support 82 | The specification for proto2 states that when deserializing a message, 83 | fields which are not transmitted should be set the the default value 84 | (either 0, or the value of the default option). 85 | 86 | However, It seems to be the norm for proto2, that it should 87 | be possible to determine if a field was transmitted or not. Therefore 88 | all non-repeated fields in proto2 are option types - unless the field has a 89 | default value, or is a required field. 90 | 91 | The proto2 specification states that no default values should be 92 | transmitted. However, as it is normal to be able to identify if a 93 | field has been transmitted or not, only fields with an explicit 94 | default value will be omitted when the value for the field matches the 95 | default value. 96 | 97 | ## Invocation 98 | If the plugin is available in the path as `protoc-gen-ocaml`, then you 99 | can generate the Ocaml code by running 100 | 101 | ``` 102 | protoc --ocaml_out=. --ocaml_opt= file.proto 103 | ``` 104 | 105 | ## Options 106 | 107 | *Options* control the code/types generated. 108 | 109 | | Option | Description | Example | Default | 110 | | ----------- | ------------------------------ | ----------------------- | ------- | 111 | | annot | Type annotations. | `annot=[@@deriving show]` | "" | 112 | | debug | Enable debugging | `debug` | Not set | 113 | | open | Add open at top of generated files. May be given multiple times | `open=Base.Sexp` | [] | 114 | | int64\_as\_int | Map \*int64 types to int instead of `int64` | `int64_as_int=false` | true | 115 | | int32\_as\_int | Map \*int32 types to int instead of `int32` | `int32_as_int=false` | true | 116 | | fixed\_as\_int | Map \*fixed\* types to `int` | `fixed_as_int=true` | false | 117 | | singleton\_record | Messages with only one field will be wrapped in a record | `singleton_records=true` | false | 118 | 119 | 120 | Parameters are separated by `;` 121 | 122 | If `protoc-gen-ocaml` is not located in the path, it is possible to 123 | specify the exact path to the plugin: 124 | 125 | ``` 126 | protoc --plugin=protoc-gen-ocaml=../plugin/ocaml-protocol-plugin.exe --ocaml_out=. .proto 127 | ``` 128 | 129 | ### Older versions of protoc 130 | It seems that the `--ocaml_opt` flag may not be supported by older 131 | versions of the proto compiler. As an alternative, options can also be 132 | passed with the `--ocaml_out` flag: 133 | 134 | ``` 135 | protoc --plugin=protoc-gen-ocaml=../plugin/ocaml.exe --ocaml_out=annot=debug;[@@deriving show { with_path = false }, eq]:. .proto 136 | ``` 137 | ## Mangle generated names 138 | Idiomatic protobuf names are somewhat alien to 139 | Ocaml. `Ocaml_protoc_plugin` has an option to mangle protobuf names 140 | into somewhat more Ocaml idiomatic names. When this option is set (see 141 | below), names are mangled to snake case as described in the table 142 | below: 143 | 144 | | Protobyf type | Protobuf name | Ocaml name | 145 | |:--------------|:-------------------------|:-------------------------| 146 | | package | `CapitalizedSnakeCase` | `Capitalized_snake_case` | 147 | | message | `CapitalizedSnakeCase` | `Capitalized_snake_case` | 148 | | field | `lowercased_snake_case` | `lowercased_snake_case` | 149 | | oneof name | `lowercased_snake_case` | `lowercased_snake_case` | 150 | | oneof field | `capitalized_snake_case` | `Capitalized_snake_case` | 151 | | enum | `CAPITALIZED_SNAKE_CASE` | `Capitalized_snake_case` | 152 | | service name | `CapitalizedSnakeCase` | `Capitalized_snake_case` | 153 | | rpc name | `LowercasedSnakeCase` | `lowercased_snake_case` | 154 | 155 | `protoc` cannot guarantee that names do not clash when mangling is 156 | enabled. If a name clash is detected (eg. `SomeMessage` and 157 | `some_message` exists in same file) an apostrophe is appended to the 158 | name to make sure names are unique. 159 | 160 | The algorithm for converting CamelCased names to snake_case is done by 161 | injecting an underscore between any lowercase and uppercase character 162 | and then lowercasing the result. 163 | 164 | ### Setting mangle option 165 | Name mangling option can only be controlled from within the protobuf 166 | specification file. This is needed as protobuf files may reference each 167 | other and it its important to make sure that included names are 168 | referenced correctly across compilation units (and invocations of 169 | protoc). 170 | 171 | To set the option use: 172 | ```protobuf 173 | // This can be placed in a common file and then included 174 | import "google/protobuf/descriptor.proto"; 175 | message options { bool mangle_names = 1; } 176 | extend google.protobuf.FileOptions { 177 | options ocaml_options = 1074; 178 | } 179 | 180 | // This option controls name generation. If true names are converted 181 | // into more ocaml ideomatic names 182 | option (ocaml_options) = { mangle_names:true }; 183 | 184 | // This message will be mapped to module name My_proto_message 185 | message MyProtoMessage { } 186 | ``` 187 | 188 | 189 | ## Using dune 190 | Below is a dune rule for generating code for `test.proto`. The 191 | `google_include` target is used to determine the base include path for 192 | google protobuf well known types. 193 | ``` 194 | (rule 195 | (targets google_include) 196 | (action (with-stdout-to %{targets} 197 | (system "pkg-config protobuf --variable=includedir")))) 198 | 199 | (rule 200 | (targets test.ml) 201 | (deps 202 | (:proto test.proto)) 203 | (action 204 | (run protoc -I %{read-lines:google_include} -I . "--ocaml_opt=annot=[@@deriving show { with_path = false }, eq]" --ocaml_out=. %{proto}))) 205 | ``` 206 | 207 | ## Service interface 208 | Service interfaces create a module with values that just references 209 | the request and reply pair. These binding can then be used with 210 | function in `Protobuf.Service`. 211 | 212 | The call function will take a `string -> string` function, which 213 | implement message sending -> receiving. 214 | 215 | The service function is a `string -> string` function which takes a 216 | handler working over the actual message types. 217 | 218 | ## Proto2 extensions 219 | Proto2 extensions allows for messages to be extended. For each 220 | extending field, the plugin create a module with a get and set 221 | function for reading/writing extension fields. 222 | 223 | Below is an example on how to set and get extension fields 224 | 225 | 226 | ```protobuf 227 | // file: ext.proto 228 | syntax = "proto2"; 229 | message Foo { 230 | required uint32 i = 1; 231 | extensions 100 to 200; 232 | 233 | } 234 | extend Foo { 235 | optional uint32 bar = 128; 236 | optional string baz = 129; 237 | } 238 | ``` 239 | 240 | ```ocaml 241 | (* file: test.ml *) 242 | 243 | open Extensions 244 | 245 | (* Set extensions *) 246 | let _ = 247 | let foo = Foo.{ i = 31; extensions' = Ocaml_protoc_plugin.Extensions.default } in 248 | let foo_with_bar = Bar.set foo (Some 42) in 249 | let foo_with_baz = Baz.set foo (Some "Test String") in 250 | let foo_with_bar_baz = Baz.set foo_with_bar (Some "Test String") in 251 | 252 | (* Get extensions *) 253 | let open Ocaml_protoc_plugin.Result in 254 | Bar.get foo_with_bar >>= fun bar -> 255 | Baz.get foo_with_baz >>= fun baz -> 256 | assert (bar = Some 42); 257 | assert (baz = Some "Test String"); 258 | Bar.get foo_with_bar_baz >>= fun bar' -> 259 | Baz.get foo_with_bar_baz >>= fun baz' -> 260 | assert (bar' = Some 42); 261 | assert (baz' = Some "Test String"); 262 | return () 263 | 264 | ``` 265 | Extensions are replaced by proto3 `Any` type, and use is discouraged. 266 | 267 | ## Proto3 Any type 268 | No special handling of any type is supported, as Ocaml does not allow 269 | for runtime types, so any type must be handled manually by 270 | serializing and deserializing the embedded message. 271 | 272 | ## Proto3 Any type 273 | Proto3 optional fields are handled in the same way as proto2 optional 274 | fields; The type is an option type, and if set, the value is always 275 | transmitted. 276 | 277 | ## Imported protofiles 278 | The generated code assumes that imported modules (generated from proto 279 | files) are available in the compilation scope. If the modules 280 | generated from imported protofiles resides in different a different 281 | scope (e.g. is compiled with `wrapped true`, they need to be made 282 | available by adding parameter `open=` to make the modules 283 | available for the compilation. 284 | 285 | ### Google Well know types 286 | Protobuf distributes a set of [*Well-Known 287 | types*](https://developers.google.com/protocol-buffers/docs/reference/google.protobuf). 288 | `ocaml-protoc-plugin` installs compiled versions of these. These can 289 | be used by linking with the package `ocaml-protoc-plugin.google_types`, and adding 290 | option `open=Google_types` to the list of parameters 291 | 292 | The distributed google types are compiled using default parameters, 293 | i.e. without any ppx annotations. 294 | 295 | If you want to change this, or add type annotations, you can copy the 296 | [dune](https://github.com/issuu/ocaml-protoc-plugin/tree/master/src/google_types/dune) 297 | from the distribution to your own project, and make alterations 298 | there. See the [echo\_deriving](https://github.com/issuu/ocaml-protoc-plugin/tree/master/examples/echo_deriving) 299 | example on how to do this. 300 | 301 | # Example 302 | 303 | `test.proto` 304 | ```protobuf 305 | syntax = "proto3"; 306 | message Address { 307 | enum Planet { 308 | Earth = 0; Mars = 1; Pluto = 2; 309 | } 310 | string street = 1; 311 | uint64 number = 2; 312 | Planet planet = 3; 313 | } 314 | 315 | message Person { 316 | uint64 id = 1; 317 | string name = 2; 318 | Address address = 3; 319 | } 320 | ``` 321 | 322 | `$ protoc --ocaml_out=. test.proto` 323 | 324 | Generates a file `test.ml` with the following signature: 325 | 326 | ```ocaml 327 | module Address : sig 328 | module rec Planet : sig 329 | type t = Earth | Mars | Pluto 330 | val to_int: t -> int 331 | val from_int: int -> t Protobuf.Deserialize.result 332 | end 333 | val name': unit -> string 334 | type t = { 335 | street: string; 336 | number: int; 337 | planet: Planet.t; 338 | } 339 | val make: ?street:string ?number:int ?planet:Planet.t -> unit -> t 340 | val to_proto: t -> Protobuf.Writer.t 341 | val from_proto: Protobuf.Reader.t -> (t, Protobuf.Deserialize.error) result 342 | end 343 | module Person : sig 344 | val name': unit -> string 345 | type t = { 346 | id: int; 347 | name: string; 348 | address: Address.t option; 349 | } 350 | val make: ?id:int ?name:string ?planet:Address.t -> unit -> t 351 | val to_proto: t -> Protobuf.Writer.t 352 | val from_proto: Protobuf.Reader.t -> (t, Protobuf.Deserialize.error) result 353 | end = struct 354 | ``` 355 | 356 | Note that if `test.proto` had a package declaration such as `package testing`, 357 | the modules `Address` and `Person` listed above would be defined as sub-modules 358 | of a top-level module `Testing`. 359 | 360 | The function `make` allows the user to create message without 361 | specifying all (or any) fields. Using this function will allow users 362 | to add fields to message later without needing to modify any code, as 363 | new fields will be set to default values. 364 | 365 | `Protobuf.Reader` and `Protobuf.Writer` are used then reading or 366 | writing protobuf binary format. Below is an example on how to decode a message 367 | and how to read a message. 368 | 369 | ```ocaml 370 | let string_of_planet = function 371 | | Address.Earth -> "earth" 372 | | Mars -> "mars" 373 | | Pluto -> "pluto" 374 | in 375 | 376 | let read_person binary_message = 377 | let reader = Protobuf.Reader.create binary_message in 378 | match Person.from_proto reader in 379 | | Ok Person.{ id; name; address = Some Address { street; number; planet } } -> 380 | Printf.printf "P: %d %s - %s %s %d\n" id name (string_of_planet planet) street number 381 | | Ok Person.{ id; name; address = None } -> 382 | Printf.printf "P: %d %s - Address unknown\n" id name 383 | | Error _ -> failwith "Could not decode" 384 | ``` 385 | 386 | More examples can be found under 387 | [examples](https://github.com/issuu/ocaml-protoc-plugin/tree/master/examples) 388 | -------------------------------------------------------------------------------- /bench/Makefile: -------------------------------------------------------------------------------- 1 | default: 2 | dune build bench.exe 3 | -------------------------------------------------------------------------------- /bench/bench.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-26"] 2 | open Base 3 | open Stdio 4 | 5 | let meassure = Bechamel_perf.Instance.cpu_clock 6 | 7 | [@@@ocaml.warning "-32"] 8 | module type Protoc_impl = sig 9 | type m 10 | val encode_pb_m: m -> Pbrt.Encoder.t -> unit 11 | val decode_pb_m: Pbrt.Decoder.t -> m 12 | end 13 | 14 | module type Plugin_impl = sig 15 | module M : sig 16 | type t 17 | val name' : unit -> string 18 | val show: t -> string 19 | val equal: t -> t -> bool 20 | val to_proto: t -> Ocaml_protoc_plugin.Writer.t 21 | val to_proto': Ocaml_protoc_plugin.Writer.t -> t -> Ocaml_protoc_plugin.Writer.t 22 | val from_proto_exn: Ocaml_protoc_plugin.Reader.t -> t 23 | end 24 | end 25 | 26 | let make_tests (type v) (module Protoc: Protoc_impl) (module Plugin: Plugin_impl with type M.t = v) v_plugin = 27 | 28 | (* Verify *) 29 | let verify_identity ~mode data = 30 | let writer = Plugin.M.to_proto' (Ocaml_protoc_plugin.Writer.init ~mode ()) data in 31 | let data' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create (Ocaml_protoc_plugin.Writer.contents writer)) in 32 | let () = match Plugin.M.equal data data' with 33 | | true -> () 34 | | false -> 35 | eprintf "Orig: %s\n" (Plugin.M.show data); 36 | eprintf "New: %s\n" (Plugin.M.show data'); 37 | failwith "Data not the same" 38 | in 39 | Ocaml_protoc_plugin.Writer.contents writer |> String.length, 40 | Ocaml_protoc_plugin.Writer.unused_space writer 41 | in 42 | let size_normal, unused_normal = verify_identity ~mode:Ocaml_protoc_plugin.Writer.Balanced v_plugin in 43 | let size_speed, unused_speed = verify_identity ~mode:Ocaml_protoc_plugin.Writer.Speed v_plugin in 44 | let size_space, unused_space = verify_identity ~mode:Ocaml_protoc_plugin.Writer.Space v_plugin in 45 | let data_plugin = Plugin.M.to_proto' (Ocaml_protoc_plugin.Writer.init ()) v_plugin |> Ocaml_protoc_plugin.Writer.contents in 46 | let v_plugin' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_plugin) in 47 | assert (Poly.equal v_plugin v_plugin'); 48 | let v_protoc = Protoc.decode_pb_m (Pbrt.Decoder.of_string data_plugin) in 49 | let protoc_encoder = Pbrt.Encoder.create () in 50 | let () = Protoc.encode_pb_m v_protoc protoc_encoder in 51 | let data_protoc = Pbrt.Encoder.to_string protoc_encoder in 52 | let v_plugin'' = Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_protoc) in 53 | let () = match Plugin.M.equal v_plugin v_plugin'' with 54 | | true -> () 55 | | false -> 56 | eprintf "Orig: %s\n" (Plugin.M.show v_plugin); 57 | eprintf "New: %s\n" (Plugin.M.show v_plugin'); 58 | failwith "Data not the same" 59 | in 60 | printf "%-16s: %5d+%-5d(B) / %5d+%-5d(S) / %5d+%-5d(Sp) - %5d\n%!" (Plugin.M.name' ()) 61 | size_normal unused_normal size_speed unused_speed size_space unused_space (String.length data_protoc); 62 | 63 | 64 | let open Bechamel in 65 | let test_encode = 66 | Test.make_grouped ~name:"Encode" 67 | [ 68 | Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.to_proto' Ocaml_protoc_plugin.Writer.(init ()) v_plugin); 69 | Test.make ~name:"Protoc" (Staged.stage @@ fun () -> let encoder = Pbrt.Encoder.create () in Protoc.encode_pb_m v_protoc encoder; Pbrt.Encoder.to_string encoder) 70 | ] 71 | in 72 | let test_decode = 73 | Test.make_grouped ~name:"Decode" 74 | [ 75 | Test.make ~name:"Plugin" (Staged.stage @@ fun () -> Plugin.M.from_proto_exn (Ocaml_protoc_plugin.Reader.create data_plugin)); 76 | Test.make ~name:"Protoc" (Staged.stage @@ fun () -> Protoc.decode_pb_m (Pbrt.Decoder.of_string data_protoc)) 77 | ] 78 | in 79 | Test.make_grouped ~name:(Plugin.M.name' ()) [test_encode; test_decode] 80 | 81 | let _ = 82 | Random.init 0; 83 | let module Gc = Stdlib.Gc in 84 | Gc.full_major (); 85 | let control = Gc.get () in 86 | Gc.set { control with minor_heap_size=4000_1000; space_overhead=500 } 87 | 88 | 89 | let random_list ~len ~f () = 90 | List.init len ~f:(fun _ -> f ()) 91 | 92 | let random_string ~len () = 93 | String.init len ~f:(fun _ -> Random.char ()) 94 | 95 | let create_test_data ~depth () = 96 | let module M = Plugin.Bench.M in 97 | let module Data = Plugin.Bench.Data in 98 | let module Enum = Plugin.Bench.Enum in 99 | let optional ~f () = 100 | match (Random.int 4 = 0) with 101 | | true -> None 102 | | false -> Some (f ()) 103 | in 104 | let create_data () = 105 | 106 | let random_enum () = 107 | Array.random_element_exn [| Enum.EA; Enum.EB; Enum.EC; Enum.ED; Enum.EE; |] 108 | in 109 | let s1 = random_string ~len:20 () in 110 | let n1 = random_list ~len:100 ~f:(fun () -> Random.int 1_000) () in 111 | let n2 = random_list ~len:100 ~f:(fun () -> Random.int 1_000) () in 112 | let d1 = random_list ~len:100 ~f:(fun () -> Random.float 1_000.) () in 113 | let n3 = Random.int 10 in 114 | let b1 = Random.bool () in 115 | let e = random_list ~len:100 ~f:random_enum () in 116 | 117 | Data.make ~s1 ~n1 ~n2 ~d1 ~n3 ~b1 (* ~e *) () 118 | in 119 | 120 | let rec create_btree n () = 121 | match n with 122 | | 0 -> None 123 | | n -> 124 | let data = random_list ~len:2 ~f:create_data () in 125 | let children = 126 | random_list ~len:2 ~f:(create_btree (n - 1)) () |> List.filter_opt 127 | in 128 | M.make ~children ~data () |> Option.some 129 | in 130 | create_btree depth () 131 | 132 | let benchmark tests = 133 | let open Bechamel in 134 | let instances = [ meassure ] in 135 | let cfg = Benchmark.cfg ~compaction:false ~kde:(Some 1) ~quota:(Time.second 1.0) () in 136 | Benchmark.all cfg instances tests 137 | 138 | let analyze results = 139 | let open Bechamel in 140 | let ols = Analyze.ols ~bootstrap:5 ~r_square:true 141 | ~predictors:[| Measure.run |] in 142 | let results = Analyze.all ols meassure results in 143 | Analyze.merge ols [ meassure ] [ results ] 144 | 145 | let print_bench_results results = 146 | let open Bechamel in 147 | let () = Bechamel_notty.Unit.add 148 | meassure 149 | (Measure.unit meassure) 150 | in 151 | 152 | let img (window, results) = 153 | Bechamel_notty.Multiple.image_of_ols_results ~rect:window 154 | ~predictor:Measure.run results 155 | in 156 | 157 | let open Notty_unix in 158 | 159 | let window = 160 | match winsize Unix.stdout with 161 | | Some (w, h) -> { Bechamel_notty.w; h } 162 | | None -> { Bechamel_notty.w= 80; h= 1; } in 163 | img (window, results) |> eol |> output_image 164 | 165 | 166 | let _ = 167 | let v_plugin = create_test_data ~depth:4 () |> Option.value_exn in 168 | [ 169 | make_tests (module Protoc.Bench) (module Plugin.Bench) v_plugin; 170 | make_tests (module Protoc.Int64) (module Plugin.Int64) 27; 171 | make_tests (module Protoc.Float) (module Plugin.Float) 27.0001; 172 | make_tests (module Protoc.String) (module Plugin.String) "Benchmark"; 173 | make_tests (module Protoc.Enum) (module Plugin.Enum) Plugin.Enum.Enum.ED; 174 | 175 | List.init 1000 ~f:(fun i -> i) |> make_tests (module Protoc.Int64_list) (module Plugin.Int64_list); 176 | List.init 1000 ~f:(fun i -> Float.of_int i) |> make_tests (module Protoc.Float_list) (module Plugin.Float_list); 177 | List.init 1000 ~f:(fun _ -> random_string ~len:20 ()) |> make_tests (module Protoc.String_list) (module Plugin.String_list); 178 | (* random_list ~len:100 ~f:(fun () -> Plugin.Enum_list.Enum.ED) () |> make_tests (module Protoc.Enum_list) (module Plugin.Enum_list); *) 179 | ] 180 | |> List.rev |> List.iter ~f:(fun test -> 181 | test 182 | |> benchmark 183 | |> analyze 184 | |> print_bench_results 185 | ) 186 | -------------------------------------------------------------------------------- /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 | (libraries protoc plugin bechamel bechamel-notty notty.unix bechamel-perf base stdio)) 4 | -------------------------------------------------------------------------------- /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/perf.data: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/issuu/ocaml-protoc-plugin/5e5a3cf30d1b124661f39222d99a1ec228f91f29/bench/perf.data -------------------------------------------------------------------------------- /bench/plugin/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets 3 | bench.ml 4 | int64.ml string.ml float.ml enum.ml 5 | int64_list.ml string_list.ml float_list.ml enum_list.ml 6 | ) 7 | (deps 8 | (:proto 9 | ../bench.proto 10 | ../int64.proto ../string.proto ../float.proto ../enum.proto 11 | ../int64_list.proto ../string_list.proto ../float_list.proto ../enum_list.proto) 12 | (:plugin ../../src/plugin/protoc_gen_ocaml.exe) 13 | ) 14 | (action 15 | (bash "for p in %{proto}; do protoc -I .. --plugin=protoc-gen-ocaml=%{plugin} \"--ocaml_out=annot=[@@deriving show { with_path = false },eq]:.\" $p; done"))) 16 | 17 | (library 18 | (name plugin) 19 | (libraries ocaml_protoc_plugin) 20 | (preprocess 21 | (pps ppx_deriving.show ppx_deriving.eq ppx_deriving.ord)) 22 | ) 23 | -------------------------------------------------------------------------------- /bench/protoc/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets 3 | bench.ml bench.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 | ) 9 | (deps 10 | (:proto 11 | ../bench.proto 12 | ../int64.proto ../string.proto ../float.proto ../enum.proto 13 | ../int64_list.proto ../string_list.proto ../float_list.proto ../enum_list.proto)) 14 | (action 15 | (bash "for p in %{proto}; do ocaml-protoc -I .. --binary --int32_type int_t --int64_type int_t --ml_out . $p; done"))) 16 | 17 | (library 18 | (name protoc) 19 | (ocamlopt_flags :standard \ -unboxed-types) 20 | (libraries pbrt)) 21 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /conf-protoc.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Issuu" 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 | ] 28 | 29 | available: (os-distribution != "ubuntu" | os-version >= "18.04") & (os-distribution != "centos" | os-version >= "8") 30 | synopsis: "Virtual package to install protoc compiler" 31 | description: 32 | "This package will install the protoc compiler if invoked via `opam depext`" 33 | flags: conf 34 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (alias 2 | (name default) 3 | (deps (alias_rec install)) 4 | ) 5 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.2) 2 | (name ocaml-protoc-plugin) 3 | -------------------------------------------------------------------------------- /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 timestamp { 11 | google.protobuf.Timestamp ts = 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 = `Ts (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 | | `Ts {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 | | `not_set -> 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 | oneof timestamp { 11 | google.protobuf.Timestamp ts = 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_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 = `Ts (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 | | `Ts {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 | | `not_set -> 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 | -------------------------------------------------------------------------------- /ocaml-protoc-plugin.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Issuu" 3 | authors: "Anders Fugmann " 4 | license: "APACHE-2.0" 5 | homepage: "https://github.com/issuu/ocaml-protoc-plugin" 6 | dev-repo: "git+https://github.com/issuu/ocaml-protoc-plugin" 7 | bug-reports: "https://github.com/issuu/ocaml-protoc-plugin/issues" 8 | doc: "https://issuu.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 | "dune" {>= "3.2"} 18 | "ocaml" {>= "4.08.0"} 19 | "ppx_expect" {with-test} 20 | "ppx_inline_test" {with-test} 21 | "ppx_deriving" {with-test} 22 | "conf-pkg-config" {build} 23 | ] 24 | 25 | 26 | synopsis: "Plugin for protoc protobuf compiler to generate ocaml definitions from a .proto file" 27 | 28 | description: """ The plugin generates ocaml type definitions, 29 | serialization and deserialization functions from a protobuf file. 30 | The types generated aims to create ocaml idiomatic types; 31 | - messages are mapped into modules 32 | - oneof constructs are mapped to polymorphic variants 33 | - enums are mapped to adt's 34 | - map types are mapped to assoc lists 35 | - all integer types are mapped to int by default (exact mapping is also possible) 36 | - all floating point types are mapped to float. 37 | - packages are mapped to nested modules 38 | """ 39 | -------------------------------------------------------------------------------- /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.ml: -------------------------------------------------------------------------------- 1 | (** Module for deserializing values *) 2 | open StdLabels 3 | 4 | module S = Spec.Deserialize 5 | module C = S.C 6 | open S 7 | 8 | type required = Required | Optional 9 | 10 | type 'a reader = 'a -> Reader.t -> Field.field_type -> 'a 11 | type 'a getter = 'a -> 'a 12 | type 'a field_spec = (int * 'a reader) 13 | type 'a value = ('a field_spec list * required * 'a * 'a getter) 14 | 15 | type (_, _) value_list = 16 | | VNil : ('a, 'a) value_list 17 | | VCons : ('a value) * ('b, 'c) value_list -> ('a -> 'b, 'c) value_list 18 | 19 | type sentinel_field_spec = int * (Reader.t -> Field.field_type -> unit) 20 | type 'a sentinel_getter = unit -> 'a 21 | 22 | type (_, _) sentinel_list = 23 | | NNil : ('a, 'a) sentinel_list 24 | | NCons : (sentinel_field_spec list * 'a sentinel_getter) * ('b, 'c) sentinel_list -> ('a -> 'b, 'c) sentinel_list 25 | 26 | let error_wrong_field str field = Result.raise (`Wrong_field_type (str, field)) 27 | let error_required_field_missing () = Result.raise `Required_field_missing 28 | 29 | let decode_zigzag v = 30 | let open Infix.Int64 in 31 | match v land 0x01L = 0L with 32 | | true -> v / 2L 33 | | false -> (v / 2L * -1L) - 1L 34 | 35 | let decode_zigzag_unboxed v = 36 | match v land 0x01 = 0 with 37 | | true -> v / 2 38 | | false -> (v / 2 * -1) - 1 39 | 40 | let int_of_uint32 v = 41 | let v = Int32.to_int v in 42 | match Sys.word_size with 43 | | 32 -> v 44 | | 64 when v < 0 -> v + 0x1_0000_0000 45 | | 64 -> v 46 | | _ -> assert false 47 | 48 | 49 | let read_of_spec: type a. a spec -> Field.field_type * (Reader.t -> a) = function 50 | | Double -> Fixed64, fun reader -> Reader.read_fixed64 reader |> Int64.float_of_bits 51 | | Float -> Fixed32, fun reader -> Reader.read_fixed32 reader |> Int32.float_of_bits 52 | | Int32 -> Varint, fun reader -> Reader.read_varint_unboxed reader |> Int32.of_int 53 | | Int32_int -> Varint, Reader.read_varint_unboxed 54 | | Int64 -> Varint, Reader.read_varint 55 | | Int64_int -> Varint, Reader.read_varint_unboxed 56 | | UInt32 -> Varint, fun reader -> Reader.read_varint_unboxed reader |> Int32.of_int 57 | | UInt32_int -> Varint, Reader.read_varint_unboxed 58 | | UInt64 -> Varint, Reader.read_varint 59 | | UInt64_int -> Varint, Reader.read_varint_unboxed 60 | | SInt32 -> Varint, fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed |> Int32.of_int 61 | | SInt32_int -> Varint, fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed 62 | | SInt64 -> Varint, fun reader -> Reader.read_varint reader |> decode_zigzag 63 | | SInt64_int -> Varint, fun reader -> Reader.read_varint_unboxed reader |> decode_zigzag_unboxed 64 | 65 | | Fixed32 -> Fixed32, Reader.read_fixed32 66 | | Fixed32_int -> Fixed32, fun reader -> Reader.read_fixed32 reader |> int_of_uint32 67 | | SFixed32 -> Fixed32, Reader.read_fixed32 68 | | SFixed32_int -> Fixed32, fun reader -> Reader.read_fixed32 reader |> Int32.to_int 69 | 70 | | Fixed64 -> Fixed64, Reader.read_fixed64 71 | | Fixed64_int -> Fixed64, fun reader -> Reader.read_fixed64 reader |> Int64.to_int 72 | | SFixed64 -> Fixed64, Reader.read_fixed64 73 | | SFixed64_int -> Fixed64, fun reader -> Reader.read_fixed64 reader |> Int64.to_int 74 | 75 | | Bool -> Varint, fun reader -> Reader.read_varint_unboxed reader != 0 76 | | Enum of_int -> Varint, fun reader -> Reader.read_varint_unboxed reader |> of_int 77 | | String -> Length_delimited, fun reader -> 78 | let Field.{ offset; length; data } = Reader.read_length_delimited reader in 79 | String.sub ~pos:offset ~len:length data 80 | | Bytes -> Length_delimited, fun reader -> 81 | let Field.{ offset; length; data } = Reader.read_length_delimited reader in 82 | let v = Bytes.create length in 83 | Bytes.blit_string ~src:data ~src_pos:offset ~dst:v ~dst_pos:0 ~len:length; 84 | v 85 | | Message from_proto -> Length_delimited, fun reader -> 86 | let Field.{ offset; length; data } = Reader.read_length_delimited reader in 87 | from_proto (Reader.create ~offset ~length data) 88 | 89 | let default_value: type a. a spec -> a = function 90 | | Double -> 0.0 91 | | Float -> 0.0 92 | | Int32 -> Int32.zero 93 | | Int64 -> Int64.zero 94 | | UInt32 -> Int32.zero 95 | | UInt64 -> Int64.zero 96 | | SInt32 -> Int32.zero 97 | | SInt64 -> Int64.zero 98 | | Fixed32 -> Int32.zero 99 | | Fixed64 -> Int64.zero 100 | | SFixed32 -> Int32.zero 101 | | SFixed64 -> Int64.zero 102 | | Message of_proto -> of_proto (Reader.create "") 103 | | String -> "" 104 | | Bytes -> Bytes.empty 105 | | Int32_int -> 0 106 | | Int64_int -> 0 107 | | UInt32_int -> 0 108 | | UInt64_int -> 0 109 | | SInt32_int -> 0 110 | | SInt64_int -> 0 111 | | Fixed32_int -> 0 112 | | Fixed64_int -> 0 113 | | SFixed32_int -> 0 114 | | SFixed64_int -> 0 115 | | Enum of_int -> of_int 0 116 | | Bool -> false 117 | 118 | let id x = x 119 | let keep_last _ v = v 120 | 121 | let read_field ~read:(expect, read_f) ~map v reader field_type = 122 | match expect = field_type with 123 | | true -> read_f reader |> map v 124 | | false -> 125 | let field = Reader.read_field_content field_type reader in 126 | error_wrong_field "Deserialize" field 127 | 128 | let value: type a. a compound -> a value = function 129 | | Basic (index, spec, default) -> 130 | let read = read_field ~read:(read_of_spec spec) ~map:keep_last in 131 | let required = match default with 132 | | Some _ -> Optional 133 | | None -> Required 134 | in 135 | let default = match default with 136 | | None -> default_value spec 137 | | Some default -> default 138 | in 139 | ([(index, read)], required, default, id) 140 | | Basic_opt (index, spec) -> 141 | let read = read_field ~read:(read_of_spec spec) ~map:(fun _ v -> Some v) in 142 | ([(index, read)], Optional, None, id) 143 | | Repeated (index, spec, Packed) -> 144 | let field_type, read_f = read_of_spec spec in 145 | let rec read_packed_values read_f acc reader = 146 | match Reader.has_more reader with 147 | | true -> read_packed_values read_f (read_f reader :: acc) reader 148 | | false -> acc 149 | in 150 | let read vs reader = fun (ft : Field.field_type) -> match ft with 151 | | Field.Length_delimited -> 152 | let Field.{ offset; length; data } = Reader.read_length_delimited reader in 153 | let reader = Reader.create ~offset ~length data in 154 | read_packed_values read_f vs reader 155 | | ft when ft = field_type -> 156 | read_f reader :: vs 157 | | ft -> 158 | let field = Reader.read_field_content ft reader in 159 | error_wrong_field "Deserialize" field 160 | in 161 | ([(index, read)], Optional, [], List.rev) 162 | | Repeated (index, spec, Not_packed) -> 163 | let read = read_field ~read:(read_of_spec spec) ~map:(fun vs v -> v :: vs) in 164 | ([(index, read)], Optional, [], List.rev) 165 | | Oneof oneofs -> 166 | let make_reader: a oneof -> a field_spec = fun (Oneof_elem (index, spec, constr)) -> 167 | let read = read_field ~read:(read_of_spec spec) ~map:(fun _ -> constr) in 168 | (index, read) 169 | in 170 | (List.map ~f:make_reader oneofs, Optional, `not_set, id) 171 | 172 | module IntMap = Map.Make(struct type t = int let compare = Int.compare end) 173 | 174 | let in_extension_ranges extension_ranges index = 175 | List.exists ~f:(fun (start, end') -> index >= start && index <= end') extension_ranges 176 | 177 | (** Full (slow) deserialization. *) 178 | let deserialize_full: type constr a. (int * int) list -> (constr, (int * Field.t) list -> a) value_list -> constr -> Reader.t -> a = fun extension_ranges values constructor reader -> 179 | (* Need to return the map also! *) 180 | let rec make_sentinel_list: type a b. (a, b) value_list -> (a, b) sentinel_list = function 181 | | VNil -> NNil 182 | (* Consider optimizing when optional is true *) 183 | | VCons ((fields, required, default, getter), rest) -> 184 | let v = ref (default, required) in 185 | let get () = match !v with 186 | | _, Required -> error_required_field_missing (); 187 | | v, Optional-> getter v 188 | in 189 | let fields = 190 | List.map ~f:(fun (index, read) -> 191 | let read reader field_type = let v' = fst !v in v := (read v' reader field_type, Optional) in 192 | (index, read) 193 | ) fields 194 | in 195 | NCons ((fields, get), make_sentinel_list rest) 196 | in 197 | 198 | let rec create_map: type a b. _ IntMap.t -> (a, b) sentinel_list -> _ IntMap.t = fun map -> function 199 | | NNil -> map 200 | | NCons ((fields, _), rest) -> 201 | let map = 202 | List.fold_left ~init:map ~f:(fun map (index, read)-> IntMap.add index read map) fields 203 | in 204 | create_map map rest 205 | in 206 | 207 | let rec apply: type constr t. constr -> (constr, t) sentinel_list -> t = fun constr -> function 208 | | NNil -> constr 209 | | NCons ((_, get), rest) -> 210 | apply (constr (get ())) rest 211 | in 212 | 213 | let rec read: (Reader.t -> Field.field_type -> unit) IntMap.t -> (int * Field.t) list -> (int * Field.t) list = fun map extensions -> 214 | match Reader.has_more reader with 215 | | false -> List.rev extensions 216 | | true -> 217 | let (field_type, field_number) = Reader.read_field_header reader in 218 | match IntMap.find_opt field_number map with 219 | | Some read_f -> 220 | read_f reader field_type; 221 | read map extensions 222 | | None when in_extension_ranges extension_ranges field_number -> 223 | let field = Reader.read_field_content field_type reader in 224 | read map ((field_number, field) :: extensions) 225 | | None -> 226 | let (_: Field.t) = Reader.read_field_content field_type reader in 227 | read map extensions 228 | in 229 | let sentinels = make_sentinel_list values in 230 | let map = create_map IntMap.empty sentinels in 231 | let extensions = read map [] in 232 | apply constructor sentinels extensions 233 | 234 | let deserialize: type constr a. (int * int) list -> (constr, (int * Field.t) list -> a) compound_list -> constr -> Reader.t -> a = fun extension_ranges spec constr -> 235 | let rec make_values: type a b. (a, b) compound_list -> (a, b) value_list = function 236 | | Nil -> VNil 237 | | Cons (spec, rest) -> 238 | let value = value spec in 239 | let values = make_values rest in 240 | VCons (value, values) 241 | in 242 | let values = make_values spec in 243 | 244 | let next_field reader = 245 | match Reader.has_more reader with 246 | | true -> Reader.read_field_header reader 247 | | false -> Field.Varint, Int.max_int 248 | in 249 | 250 | let rec read_values: type constr a. (int * int) list -> Field.field_type -> int -> Reader.t -> constr -> (int * Field.t) list -> (constr, (int * Field.t) list -> a) value_list -> a option = fun extension_ranges tpe idx reader constr extensions -> 251 | let rec read_repeated tpe index read_f default get reader = 252 | let default = read_f default reader tpe in 253 | let (tpe, idx) = next_field reader in 254 | match idx = index with 255 | | true -> read_repeated tpe index read_f default get reader 256 | | false -> default, tpe, idx 257 | in 258 | function 259 | | VCons (([index, read_f], _required, default, get), vs) when index = idx -> 260 | (* Read all values, and apply constructor once all fields have been read. 261 | This pattern is the most likely to be matched for all values, and is added 262 | as an optimization to avoid reconstructing the value list for each recursion. 263 | *) 264 | let default, tpe, idx = read_repeated tpe index read_f default get reader in 265 | let constr = (constr (get default)) in 266 | read_values extension_ranges tpe idx reader constr extensions vs 267 | | VCons (((index, read_f) :: fields, _required, default, get), vs) when index = idx -> 268 | (* Read all values for the given field *) 269 | let default, tpe, idx = read_repeated tpe index read_f default get reader in 270 | read_values extension_ranges tpe idx reader constr extensions (VCons ((fields, Optional, default, get), vs)) 271 | | vs when in_extension_ranges extension_ranges idx -> 272 | (* Extensions may be sent inline. Store all valid extensions, before starting to apply constructors *) 273 | let extensions = (idx, Reader.read_field_content tpe reader) :: extensions in 274 | let (tpe, idx) = next_field reader in 275 | read_values extension_ranges tpe idx reader constr extensions vs 276 | | VCons (([], Required, _default, _get), _vs) -> 277 | (* If there are no more fields to be read we will never find the value. 278 | If all values are read, then raise, else revert to full deserialization *) 279 | begin match (idx = Int.max_int) with 280 | | true -> error_required_field_missing () 281 | | false -> None 282 | end 283 | | VCons ((_ :: fields, optional, default, get), vs) -> 284 | (* Drop the field, as we dont expect to find it. *) 285 | read_values extension_ranges tpe idx reader constr extensions (VCons ((fields, optional, default, get), vs)) 286 | | VCons (([], Optional, default, get), vs) -> 287 | (* Apply destructor. This case is only relevant for oneof fields *) 288 | read_values extension_ranges tpe idx reader (constr (get default)) extensions vs 289 | | VNil when idx = Int.max_int -> 290 | (* All fields read successfully. Apply extensions and return result. *) 291 | Some (constr (List.rev extensions)) 292 | | VNil -> 293 | (* This implies that there are still fields to be read. 294 | Revert to full deserialization. 295 | *) 296 | None 297 | in 298 | fun reader -> 299 | let offset = Reader.offset reader in 300 | let (tpe, idx) = next_field reader in 301 | read_values extension_ranges tpe idx reader constr [] values 302 | |> function 303 | | Some t -> t 304 | | None -> 305 | Reader.reset reader offset; 306 | deserialize_full extension_ranges values constr reader 307 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/deserialize.mli: -------------------------------------------------------------------------------- 1 | module C = Spec.Deserialize.C 2 | 3 | val deserialize: (int * int) list -> 4 | ('constr, (int * Field.t) list -> 'a) Spec.Deserialize.compound_list -> 5 | 'constr -> Reader.t -> 'a 6 | -------------------------------------------------------------------------------- /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 | (preprocess (pps ppx_expect)) 7 | ) 8 | -------------------------------------------------------------------------------- /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. a Spec.Serialize.compound -> int = function 12 | | Basic (index, _, _) -> index 13 | | Basic_opt (index, _) -> index 14 | | Repeated (index, _, _) -> index 15 | | Oneof _ -> failwith "Oneof fields not allowed in extensions" 16 | 17 | let get: type a. a Spec.Deserialize.compound -> t -> a = fun spec t -> 18 | let writer = Writer.of_list t in 19 | let reader = Writer.contents writer |> Reader.create in 20 | Deserialize.deserialize [] Spec.Deserialize.(Cons (spec, Nil)) (fun a _ -> a) reader 21 | 22 | let set: type a. a Spec.Serialize.compound -> t -> a -> t = fun spec t v -> 23 | let writer = Writer.init () in 24 | let writer = Serialize.serialize [] Spec.Serialize.(Cons (spec, Nil)) [] writer v in 25 | let index = index_of_spec spec in 26 | let fields = 27 | Writer.contents writer 28 | |> Reader.create 29 | |> Reader.to_list 30 | in 31 | List.filter ~f:(fun (i, _) -> i != index) t @ fields 32 | -------------------------------------------------------------------------------- /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.Deserialize.compound -> t -> 'a 9 | val set: 'a Spec.Serialize.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/ocaml_protoc_plugin.ml: -------------------------------------------------------------------------------- 1 | (**/**) 2 | module Serialize = Serialize 3 | module Deserialize = Deserialize 4 | module Spec = Spec 5 | module Runtime = Runtime 6 | (**/**) 7 | 8 | module Reader = Reader 9 | module Writer = Writer 10 | module Service = Service 11 | module Result = Result 12 | module Extensions = Extensions 13 | -------------------------------------------------------------------------------- /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 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 | [@@inline] 29 | 30 | let has_more t = t.offset < t.end_offset 31 | [@@inline] 32 | 33 | let read_byte t = 34 | match t.offset < t.end_offset with 35 | | true -> 36 | let v = String.unsafe_get t.data t.offset |> Char.code in 37 | t.offset <- t.offset + 1; 38 | v 39 | | false -> Result.raise `Premature_end_of_input 40 | [@@inline] 41 | 42 | let read_varint t = 43 | let open Infix.Int64 in 44 | let rec inner acc bit = 45 | let v = read_byte t |> Int64.of_int in 46 | let acc = acc lor ((v land 0x7fL) lsl bit) in 47 | match v land 0x80L = 0x80L with 48 | | true -> 49 | inner acc (Int.add bit 7) 50 | | false -> acc 51 | in 52 | inner 0L 0[@@unrolled 10] 53 | 54 | let read_varint_unboxed t = read_varint t |> Int64.to_int 55 | 56 | let read_fixed32 t = 57 | let size = 4 in 58 | validate_capacity t size; 59 | let v = Bytes.get_int32_le (Bytes.unsafe_of_string t.data) t.offset in 60 | t.offset <- t.offset + size; 61 | v 62 | 63 | let read_fixed64 t = 64 | let size = 8 in 65 | validate_capacity t size; 66 | let v = Bytes.get_int64_le (Bytes.unsafe_of_string t.data) t.offset in 67 | t.offset <- t.offset + size; 68 | v 69 | 70 | let read_length_delimited t = 71 | let length = read_varint_unboxed t in 72 | validate_capacity t length; 73 | let v = Field.{ offset = t.offset; length = length; data = t.data } in 74 | t.offset <- t.offset + length; 75 | v 76 | 77 | let read_field_header: t -> Field.field_type * int = fun t -> 78 | let v = read_varint_unboxed t in 79 | let tpe : Field.field_type = match v land 0x7 with 80 | | 0 -> Varint 81 | | 1 -> Fixed64 82 | | 2 -> Length_delimited 83 | | 5 -> Fixed32 84 | | _ -> failwith (Printf.sprintf "Illegal field header: 0x%x" v) 85 | in 86 | let field_number = v / 8 in 87 | (tpe, field_number) 88 | 89 | let read_field_content: Field.field_type -> t -> Field.t = function 90 | | Varint -> fun r -> Field.Varint (read_varint r) 91 | | Fixed64 -> fun r -> Field.Fixed_64_bit (read_fixed64 r) 92 | | Length_delimited -> fun r -> Length_delimited (read_length_delimited r) 93 | | Fixed32 -> fun r -> Field.Fixed_32_bit (read_fixed32 r) 94 | 95 | let to_list: t -> (int * Field.t) list = 96 | let read_field t = 97 | let (tpe, index) = read_field_header t in 98 | let field = read_field_content tpe t in 99 | (index, field) 100 | in 101 | let rec next t () = match has_more t with 102 | | true -> Seq.Cons (read_field t, next t) 103 | | false -> Seq.Nil 104 | in 105 | fun t -> 106 | next t |> List.of_seq 107 | 108 | 109 | let%expect_test "varint boxed" = 110 | let values = [-2L; -1L; 0x7FFFFFFFFFFFFFFFL; 0x7FFFFFFFFFFFFFFEL; 0x3FFFFFFFFFFFFFFFL; 0x3FFFFFFFFFFFFFFEL; 0L; 1L] in 111 | List.iter ~f:(fun v -> 112 | let buffer = 113 | let writer = Writer.init () in 114 | Writer.write_varint_value v writer; 115 | Writer.contents writer 116 | in 117 | Printf.printf "0x%016LxL = 0x%016LxL\n" 118 | v 119 | (read_varint (create buffer)); 120 | () 121 | ) values; 122 | [%expect {| 123 | 0xfffffffffffffffeL = 0xfffffffffffffffeL 124 | 0xffffffffffffffffL = 0xffffffffffffffffL 125 | 0x7fffffffffffffffL = 0x7fffffffffffffffL 126 | 0x7ffffffffffffffeL = 0x7ffffffffffffffeL 127 | 0x3fffffffffffffffL = 0x3fffffffffffffffL 128 | 0x3ffffffffffffffeL = 0x3ffffffffffffffeL 129 | 0x0000000000000000L = 0x0000000000000000L 130 | 0x0000000000000001L = 0x0000000000000001L |}] 131 | -------------------------------------------------------------------------------- /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 | (**/**) 20 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/result.ml: -------------------------------------------------------------------------------- 1 | (** This module provides result type and functions for compatibility 2 | * with OCaml 4.06 *) 3 | 4 | type error = 5 | [ `Premature_end_of_input 6 | | `Unknown_field_type of int 7 | | `Wrong_field_type of string * Field.t 8 | | `Illegal_value of string * Field.t 9 | | `Unknown_enum_value of int 10 | | `Oneof_missing 11 | | `Required_field_missing ] 12 | 13 | exception Error of error 14 | type 'a t = ('a, error) result 15 | 16 | let raise error = raise (Error error) 17 | let catch f = try Ok (f ()) with Error (#error as v) -> Error v 18 | 19 | let ( >>| ) : 'a t -> ('a -> 'b) -> 'b t = function Ok x -> fun f -> Ok (f x) | Error err -> fun _ -> Error err 20 | let ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t = function Ok x -> fun f -> f x | Error err -> fun _ -> Error err 21 | 22 | (* Extra functions (from Base) *) 23 | 24 | let return x = Ok x 25 | let fail : error -> 'a t = fun x -> Error x 26 | let get ~msg = function 27 | | Ok v -> v 28 | | Error _ -> failwith msg 29 | 30 | let pp_error : Format.formatter -> [> error] -> unit = fun fmt -> function 31 | | `Premature_end_of_input -> 32 | Format.pp_print_string fmt 33 | "`Premature_end_of_input" 34 | | `Unknown_field_type x -> 35 | (Format.fprintf fmt 36 | "`Unknown_field_type (@["; 37 | (Format.fprintf fmt "%d") x; 38 | Format.fprintf fmt "@])") 39 | | `Wrong_field_type x -> 40 | (Format.fprintf fmt 41 | "`Wrong_field_type (@["; 42 | ((fun (a0, a1) -> 43 | Format.fprintf fmt "(@["; 44 | ((Format.fprintf fmt "%S") a0; 45 | Format.fprintf fmt ",@ "; 46 | (Field.pp fmt) a1); 47 | Format.fprintf fmt "@])")) x; 48 | Format.fprintf fmt "@])") 49 | | `Illegal_value x -> 50 | (Format.fprintf fmt 51 | "`Illegal_value (@["; 52 | ((fun (a0, a1) -> 53 | Format.fprintf fmt "(@["; 54 | ((Format.fprintf fmt "%S") a0; 55 | Format.fprintf fmt ",@ "; 56 | (Field.pp fmt) a1); 57 | Format.fprintf fmt "@])")) x; 58 | Format.fprintf fmt "@])") 59 | | `Unknown_enum_value x -> 60 | (Format.fprintf fmt 61 | "`Unknown_enum_value (@["; 62 | (Format.fprintf fmt "%d") x; 63 | Format.fprintf fmt "@])") 64 | | `Oneof_missing -> 65 | Format.pp_print_string fmt "`Oneof_missing" 66 | | `Required_field_missing -> 67 | Format.pp_print_string fmt 68 | "`Required_field_missing" 69 | let show_error : error -> string = Format.asprintf "%a" pp_error 70 | 71 | let _ = 72 | Printexc.register_printer (function Error e -> Printf.sprintf "Ocaml_protoc_plugin.Result.Error (%s)" (show_error e) |> Option.some | _ -> None) 73 | 74 | let pp pp fmt = function 75 | | Ok v -> Format.fprintf fmt "Ok %a" pp v 76 | | Error (#error as e) -> Format.fprintf fmt "Error %a" pp_error e 77 | 78 | (* let show : 'a t -> string = Format.asprintf "%a" pp *) 79 | -------------------------------------------------------------------------------- /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 * Field.t 5 | | `Illegal_value of string * Field.t 6 | | `Unknown_enum_value of int 7 | | `Oneof_missing 8 | | `Required_field_missing ] 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/runtime.ml: -------------------------------------------------------------------------------- 1 | module Runtime' = struct 2 | module Serialize = Serialize 3 | module Deserialize = Deserialize 4 | module Spec = Spec 5 | module Result = Result 6 | module Service = Service 7 | module Extensions = Extensions 8 | module Reader = Reader 9 | module Writer = Writer 10 | end 11 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/serialize.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | 3 | module S = Spec.Serialize 4 | module C = S.C 5 | open S 6 | 7 | let field_type: type a. a spec -> int = function 8 | | Int64 | UInt64 | SInt64 | Int32 | UInt32 | SInt32 9 | | Int64_int | UInt64_int | Int32_int | UInt32_int | SInt64_int | SInt32_int 10 | | Bool | Enum _ -> 0 (* Varint *) 11 | | String | Bytes | Message _ -> 2 (* Length delimited *) 12 | | Double | Fixed64 | SFixed64 | Fixed64_int | SFixed64_int -> 1 (* Fixed 64 bit *) 13 | | Float | Fixed32 | SFixed32 | Fixed32_int | SFixed32_int -> 5 (* Fixed 32 bit *) 14 | 15 | let write_fixed64 ~f v = 16 | Writer.write_fixed64_value (f v) 17 | 18 | let write_fixed32 ~f v = 19 | Writer.write_fixed32_value (f v) 20 | 21 | let zigzag_encoding v = 22 | let open Infix.Int64 in 23 | let v = match v < 0L with 24 | | true -> v lsl 1 lxor (-1L) 25 | | false -> v lsl 1 26 | in 27 | v 28 | 29 | let zigzag_encoding_unboxed v = 30 | let v = match v < 0 with 31 | | true -> v lsl 1 lxor (-1) 32 | | false -> v lsl 1 33 | in 34 | v 35 | 36 | let write_varint ~f v = 37 | Writer.write_varint_value (f v) 38 | 39 | let write_varint_unboxed ~f v = 40 | Writer.write_varint_unboxed_value (f v) 41 | 42 | let write_length_delimited_string ~f v = 43 | let v = f v in 44 | Writer.write_length_delimited_value ~data:v ~offset:0 ~len:(String.length v) 45 | 46 | let id x = x 47 | let (@@) a b = fun v -> b (a v) 48 | 49 | let write_value : type a. a spec -> a -> Writer.t -> unit = function 50 | | Double -> write_fixed64 ~f:Int64.bits_of_float 51 | | Float -> write_fixed32 ~f:Int32.bits_of_float 52 | | Fixed64 -> write_fixed64 ~f:id 53 | | SFixed64 -> write_fixed64 ~f:id 54 | | Fixed64_int -> write_fixed64 ~f:Int64.of_int 55 | | SFixed64_int -> write_fixed64 ~f:Int64.of_int 56 | | Fixed32 -> write_fixed32 ~f:id 57 | | SFixed32 -> write_fixed32 ~f:id 58 | | Fixed32_int -> write_fixed32 ~f:Int32.of_int 59 | | SFixed32_int -> write_fixed32 ~f:Int32.of_int 60 | | Int64 -> write_varint ~f:id 61 | | UInt64 -> write_varint ~f:id 62 | | SInt64 -> write_varint ~f:zigzag_encoding 63 | | Int32 -> write_varint_unboxed ~f:Int32.to_int 64 | | UInt32 -> write_varint_unboxed ~f:Int32.to_int 65 | | SInt32 -> write_varint_unboxed ~f:(Int32.to_int @@ zigzag_encoding_unboxed) 66 | | Int64_int -> write_varint_unboxed ~f:id 67 | | UInt64_int -> write_varint_unboxed ~f:id 68 | | Int32_int -> write_varint_unboxed ~f:id 69 | | UInt32_int -> write_varint_unboxed ~f:id 70 | | SInt64_int -> write_varint_unboxed ~f:zigzag_encoding_unboxed 71 | | SInt32_int -> write_varint_unboxed ~f:zigzag_encoding_unboxed 72 | 73 | | Bool -> write_varint_unboxed ~f:(function true -> 1 | false -> 0) 74 | | String -> write_length_delimited_string ~f:id 75 | | Bytes -> write_length_delimited_string ~f:Bytes.unsafe_to_string 76 | | Enum f -> write_varint_unboxed ~f 77 | | Message to_proto -> 78 | Writer.write_length_delimited_value' ~write:to_proto 79 | 80 | (** Optimized when the value is given in advance, and the continuation is expected to be called multiple times *) 81 | let write_value_const : type a. a spec -> a -> Writer.t -> unit = fun spec v -> 82 | let write_value = write_value spec in 83 | let writer = Writer.init () in 84 | write_value v writer; 85 | let data = Writer.contents writer in 86 | Writer.write_const_value data 87 | 88 | let write_field_header: 'a spec -> int -> Writer.t -> unit = fun spec index -> 89 | let field_type = field_type spec in 90 | let header = (index lsl 3) + field_type in 91 | write_value_const Int64_int header 92 | 93 | let write_field: type a. a spec -> int -> a -> Writer.t -> unit = fun spec index -> 94 | let write_field_header = write_field_header spec index in 95 | let write_value = write_value spec in 96 | fun v writer -> 97 | write_field_header writer; 98 | write_value v writer 99 | 100 | let rec write: type a. a compound -> Writer.t -> a -> unit = function 101 | | Repeated (index, spec, Packed) -> begin 102 | let write_value = write_value spec in 103 | let write writer vs = List.iter ~f:(fun v -> write_value v writer) vs in 104 | let write_header = write_field_header String index in 105 | fun writer vs -> 106 | match vs with 107 | | [] -> () 108 | | vs -> 109 | write_header writer; 110 | Writer.write_length_delimited_value' ~write vs writer 111 | end 112 | | Repeated (index, spec, Not_packed) -> 113 | let write = write_field spec index in 114 | fun writer vs -> 115 | List.iter ~f:(fun v -> write v writer) vs 116 | 117 | (* For required fields the default is none, and the field must always be written! 118 | Consider a Basic_req (index, spec) instead. Then default is not an option type, 119 | and the code is simpler to read 120 | *) 121 | | Basic (index, spec, default) -> begin 122 | let write = write_field spec index in 123 | match default with 124 | | Some default -> 125 | fun writer v -> begin 126 | match v with 127 | | v when v = default -> () 128 | | v -> write v writer 129 | end 130 | | None -> 131 | fun writer v -> write v writer 132 | end 133 | | Basic_opt (index, spec) -> begin 134 | let write = write_field spec index in 135 | fun writer v -> 136 | match v with 137 | | Some v -> write v writer 138 | | None -> () 139 | end 140 | | Oneof f -> begin 141 | fun writer v -> 142 | match v with 143 | | `not_set -> () 144 | | v -> 145 | (* Wonder if we could get the specs before calling v. Wonder what f is? *) 146 | (* We could prob. return a list of all possible values + f v -> v. *) 147 | let Oneof_elem (index, spec, v) = f v in 148 | write (Basic (index, spec, None)) writer v 149 | end 150 | 151 | let rec serialize : type a. (a, Writer.t) compound_list -> Writer.t -> a = function 152 | | Nil -> fun writer -> writer 153 | | Cons (compound, rest) -> 154 | let cont = serialize rest in 155 | let write = write compound in 156 | fun writer v -> 157 | write writer v; 158 | cont writer 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 serialize extension_ranges spec = 164 | let serialize = serialize spec in 165 | match extension_ranges with 166 | | [] -> fun _ -> serialize 167 | | extension_ranges -> 168 | fun extensions writer -> 169 | List.iter ~f:(function 170 | | (index, field) when in_extension_ranges extension_ranges index -> Writer.write_field writer index field 171 | | _ -> () 172 | ) extensions; 173 | serialize writer 174 | 175 | let%expect_test "zigzag encoding" = 176 | let test v = 177 | let vl = Int64.of_int v in 178 | Printf.printf "zigzag_encoding(%LdL) = %LdL\n" vl (zigzag_encoding vl); 179 | Printf.printf "zigzag_encoding_unboxed(%d) = %d\n" v (zigzag_encoding_unboxed v); 180 | in 181 | List.iter ~f:test [0; -1; 1; -2; 2; 2147483647; -2147483648; Int.max_int; Int.min_int; ]; 182 | [%expect {| 183 | zigzag_encoding(0L) = 0L 184 | zigzag_encoding_unboxed(0) = 0 185 | zigzag_encoding(-1L) = 1L 186 | zigzag_encoding_unboxed(-1) = 1 187 | zigzag_encoding(1L) = 2L 188 | zigzag_encoding_unboxed(1) = 2 189 | zigzag_encoding(-2L) = 3L 190 | zigzag_encoding_unboxed(-2) = 3 191 | zigzag_encoding(2L) = 4L 192 | zigzag_encoding_unboxed(2) = 4 193 | zigzag_encoding(2147483647L) = 4294967294L 194 | zigzag_encoding_unboxed(2147483647) = 4294967294 195 | zigzag_encoding(-2147483648L) = 4294967295L 196 | zigzag_encoding_unboxed(-2147483648) = 4294967295 197 | zigzag_encoding(4611686018427387903L) = 9223372036854775806L 198 | zigzag_encoding_unboxed(4611686018427387903) = -2 199 | zigzag_encoding(-4611686018427387904L) = 9223372036854775807L 200 | zigzag_encoding_unboxed(-4611686018427387904) = -1 |}] 201 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/service.ml: -------------------------------------------------------------------------------- 1 | module type Message = sig 2 | type t 3 | val from_proto: Reader.t -> t Result.t 4 | val to_proto: t -> Writer.t 5 | end 6 | 7 | module type Rpc = sig 8 | module Request : Message 9 | module Response : Message 10 | 11 | (** gRPC service name as defined by the gRPC http2 spec. 12 | see https://github.com/grpc/grpc/blob/master/doc/PROTOCOL-HTTP2.md#appendix-a---grpc-for-protobuf 13 | *) 14 | val name : string 15 | 16 | (** Name of the enclosed package name if any *) 17 | val package_name : string option 18 | 19 | (** Name of the service in which this method is defined *) 20 | val service_name : string 21 | 22 | (** Name of the method *) 23 | val method_name : string 24 | end 25 | 26 | let make_client_functions (type req) (type rep) 27 | ((module Request : Message with type t = req), 28 | (module Response : Message with type t = rep)) = 29 | Request.to_proto, Response.from_proto 30 | 31 | let make_service_functions (type req) (type rep) 32 | ((module Request : Message with type t = req), 33 | (module Response : Message with type t = rep)) = 34 | Request.from_proto, Response.to_proto 35 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/spec.ml: -------------------------------------------------------------------------------- 1 | module type T = sig 2 | type ('a, 'deser, 'ser) dir 3 | end 4 | 5 | module Make(T : T) = struct 6 | 7 | type packed = Packed | Not_packed 8 | 9 | type _ spec = 10 | | Double : float spec 11 | | Float : float spec 12 | 13 | | Int32 : Int32.t spec 14 | | UInt32 : Int32.t spec 15 | | SInt32 : Int32.t spec 16 | | Fixed32 : Int32.t spec 17 | | SFixed32 : Int32.t spec 18 | 19 | | Int32_int : int spec 20 | | UInt32_int : int spec 21 | | SInt32_int : int spec 22 | | Fixed32_int : int spec 23 | | SFixed32_int : int spec 24 | 25 | | UInt64 : Int64.t spec 26 | | Int64 : Int64.t spec 27 | | SInt64 : Int64.t spec 28 | | Fixed64 : Int64.t spec 29 | | SFixed64 : Int64.t spec 30 | 31 | | UInt64_int : int spec 32 | | Int64_int : int spec 33 | | SInt64_int : int spec 34 | | Fixed64_int : int spec 35 | | SFixed64_int : int spec 36 | 37 | | Bool : bool spec 38 | | String : string spec 39 | | Bytes : bytes spec 40 | | Enum : ('a, int -> 'a, 'a -> int) T.dir -> 'a spec 41 | | Message : ('a, Reader.t -> 'a, Writer.t -> 'a -> Writer.t) T.dir -> 'a spec 42 | 43 | type _ oneof = 44 | | Oneof_elem : int * 'b spec * ('a, ('b -> 'a), 'b) T.dir -> 'a oneof 45 | 46 | type _ compound = 47 | | Basic : int * 'a spec * 'a option -> 'a compound 48 | | Basic_opt : int * 'a spec -> 'a option compound 49 | | Repeated : int * 'a spec * packed -> 'a list compound 50 | | Oneof : ('a, 'a oneof list, 'a -> unit oneof) T.dir -> ([> `not_set ] as 'a) compound 51 | 52 | type (_, _) compound_list = 53 | | Nil : ('a, 'a) compound_list 54 | | Cons : ('a compound) * ('b, 'c) compound_list -> ('a -> 'b, 'c) compound_list 55 | 56 | module C = struct 57 | let double = Double 58 | let float = Float 59 | let int32 = Int32 60 | let int64 = Int64 61 | let uint32 = UInt32 62 | let uint64 = UInt64 63 | let sint32 = SInt32 64 | let sint64 = SInt64 65 | let fixed32 = Fixed32 66 | let fixed64 = Fixed64 67 | let sfixed32 = SFixed32 68 | let sfixed64 = SFixed64 69 | 70 | let int32_int = Int32_int 71 | let int64_int = Int64_int 72 | let uint32_int = UInt32_int 73 | let uint64_int = UInt64_int 74 | let sint32_int = SInt32_int 75 | let sint64_int = SInt64_int 76 | let fixed32_int = Fixed32_int 77 | let fixed64_int = Fixed64_int 78 | let sfixed32_int = SFixed32_int 79 | let sfixed64_int = SFixed64_int 80 | 81 | let bool = Bool 82 | let string = String 83 | let bytes = Bytes 84 | let enum f = Enum f 85 | let message f = Message f 86 | 87 | let some v = Some v 88 | let none = None 89 | let default_bytes v = (Some (Bytes.of_string v)) 90 | 91 | let repeated (i, s, p) = Repeated (i, s, p) 92 | let basic (i, s, d) = Basic (i, s, d) 93 | let basic_opt (i, s) = Basic_opt (i, s) 94 | let oneof s = Oneof s 95 | let oneof_elem (a, b, c) = Oneof_elem (a, b, c) 96 | 97 | let packed = Packed 98 | let not_packed = Not_packed 99 | 100 | let ( ^:: ) a b = Cons (a, b) 101 | let nil = Nil 102 | 103 | let show: type a. a spec -> string = function 104 | | Double -> "Double" 105 | | Float -> "Float" 106 | 107 | | Int32 -> "Int32" 108 | | UInt32 -> "UInt32" 109 | | SInt32 -> "SInt32" 110 | | Fixed32 -> "Fixed32" 111 | | SFixed32 -> "SFixed32" 112 | 113 | | Int32_int -> "Int32_int" 114 | | UInt32_int -> "UInt32_int" 115 | | SInt32_int -> "SInt32_int" 116 | | Fixed32_int -> "Fixed32_int" 117 | | SFixed32_int -> "SFixed32_int" 118 | 119 | | UInt64 -> "UInt64" 120 | | Int64 -> "Int64" 121 | | SInt64 -> "SInt64" 122 | | Fixed64 -> "Fixed64" 123 | | SFixed64 -> "SFixed64" 124 | 125 | | UInt64_int -> "UInt64_int" 126 | | Int64_int -> "Int64_int" 127 | | SInt64_int -> "SInt64_int" 128 | | Fixed64_int -> "Fixed64_int" 129 | | SFixed64_int -> "SFixed64_int" 130 | 131 | | Bool -> "Bool" 132 | | String -> "String" 133 | | Bytes -> "Bytes" 134 | | Enum _ -> "Enum" 135 | | Message _ -> "Message" 136 | end 137 | end 138 | 139 | module Deserialize = Make(struct 140 | type ('a, 'deser, 'ser) dir = 'deser 141 | end) 142 | 143 | module Serialize = Make(struct 144 | type ('a, 'deser, 'ser) dir = 'ser 145 | end) 146 | -------------------------------------------------------------------------------- /src/ocaml_protoc_plugin/writer.ml: -------------------------------------------------------------------------------- 1 | (** Some buffer to hold data, and to read and write data *) 2 | open StdLabels 3 | open Field 4 | 5 | let length_delimited_size_field_length = 5 6 | 7 | type substring = { mutable offset: int; buffer: Bytes.t } 8 | 9 | type mode = Balanced | Speed | Space 10 | type t = { mutable data: substring list; mode: mode; block_size:int } 11 | 12 | let init ?(mode = Space) ?(block_size = 256) () = 13 | { data = []; mode; block_size } 14 | 15 | let size t = 16 | let rec inner acc = function 17 | | [] -> acc 18 | | { offset; _} :: tl -> inner (offset + acc) tl 19 | in 20 | inner 0 t.data 21 | 22 | let unused_space t = 23 | let rec inner = function 24 | | { offset; buffer } :: xs -> (Bytes.length buffer) - offset + inner xs 25 | | [] -> 0 26 | in 27 | inner t.data 28 | 29 | let write_varint buffer ~offset v = 30 | let rec inner ~offset v = 31 | let next_offset = offset + 1 in 32 | let open Infix.Int64 in 33 | match v lsr 7 with 34 | | 0L -> 35 | Bytes.unsafe_set buffer offset (Int64.to_int v |> Char.unsafe_chr); 36 | next_offset 37 | | rem -> 38 | Bytes.unsafe_set buffer offset ((v land 0x7fL) lor 0b1000_0000L |> Int64.to_int |> Char.unsafe_chr); 39 | inner ~offset:next_offset rem 40 | in 41 | inner ~offset v[@@unrolled 10] 42 | 43 | let write_varint_unboxed buffer ~offset v = write_varint buffer ~offset (Int64.of_int v) 44 | 45 | (* Write a field delimited length. 46 | A delimited field length can be no larger than 2^31. 47 | This function always write 5 bytes (7*5bits = 35bits > 31bits). 48 | This allows the field length to be statically allocated and written later. 49 | The spec does not forbid this encoding, but there might be implementation 50 | that disallow '0' as the ending varint value. 51 | *) 52 | let write_delimited_field_length_fixed_size buffer ~offset v = 53 | (* Set the 34'th bit to make sure all bytes are written. Then clear it again *) 54 | let offset = write_varint_unboxed buffer ~offset (v lor 0x400000000) in 55 | let v = Bytes.get_uint8 buffer (offset - 1) in 56 | Bytes.set_uint8 buffer (offset-1) (v land 0b0011_1111); 57 | offset 58 | 59 | 60 | let ensure_capacity ~size t = 61 | match t.data with 62 | | { offset; buffer } as elem :: _ when Bytes.length buffer - offset >= size -> elem 63 | | tl -> 64 | let elem = { offset = 0; buffer = Bytes.create (size + t.block_size) } in 65 | t.data <- elem :: tl; 66 | elem 67 | 68 | (** Direct functions *) 69 | let write_const_value data t = 70 | let len = String.length data in 71 | let elem = ensure_capacity ~size:len t in 72 | Bytes.blit_string ~src:data ~src_pos:0 ~dst:elem.buffer ~dst_pos:elem.offset ~len; 73 | elem.offset <- elem.offset + len 74 | 75 | let write_fixed32_value: int32 -> t -> unit = fun v t -> 76 | let elem = ensure_capacity ~size:4 t in 77 | Bytes.set_int32_le elem.buffer elem.offset v; 78 | elem.offset <- elem.offset + 4 79 | 80 | let write_fixed64_value: int64 -> t -> unit = fun v t -> 81 | let elem = ensure_capacity ~size:8 t in 82 | Bytes.set_int64_le elem.buffer elem.offset v; 83 | elem.offset <- elem.offset + 8 84 | 85 | let write_varint_unboxed_value: int -> t -> unit = fun v t -> 86 | let elem = ensure_capacity ~size:10 t in 87 | let offset = write_varint_unboxed elem.buffer ~offset:elem.offset v in 88 | elem.offset <- offset 89 | 90 | let write_varint_value: int64 -> t -> unit = fun v t -> 91 | let elem = ensure_capacity ~size:10 t in 92 | let offset = write_varint elem.buffer ~offset:elem.offset v in 93 | elem.offset <- offset 94 | 95 | let write_length_delimited_value: data:string -> offset:int -> len:int -> t -> unit = fun ~data ~offset ~len t -> 96 | write_varint_unboxed_value len t; 97 | let elem = ensure_capacity ~size:len t in 98 | Bytes.blit_string ~src:data ~src_pos:offset ~dst:elem.buffer ~dst_pos:elem.offset ~len; 99 | elem.offset <- elem.offset + len 100 | 101 | let write_field_header : t -> int -> int -> unit = fun t index field_type -> 102 | let header = (index lsl 3) + field_type in 103 | write_varint_unboxed_value header t 104 | 105 | let write_field : t -> int -> Field.t -> unit = fun t index field -> 106 | let field_type, writer = 107 | match field with 108 | | Varint v -> 109 | 0, write_varint_value v 110 | | Varint_unboxed v -> 111 | 0, write_varint_unboxed_value v 112 | | Fixed_64_bit v -> 113 | 1, write_fixed64_value v 114 | | Length_delimited {offset; length; data} -> 115 | 2, write_length_delimited_value ~data ~offset ~len:length 116 | | Fixed_32_bit v -> 117 | 5, write_fixed32_value v 118 | in 119 | write_field_header t index field_type; 120 | writer t 121 | 122 | 123 | let write_length_delimited_value' ~write v t = 124 | let rec size_data_added sentinel acc = function 125 | | [] -> failwith "End of list reached. This is impossible" 126 | | x :: _ when x == sentinel -> acc 127 | | { offset; _ } :: xs -> size_data_added sentinel (offset + acc) xs 128 | in 129 | let write_balanced v t = 130 | let sentinel = 131 | match t.data with 132 | | { offset; buffer} as sentinel :: _ when offset + length_delimited_size_field_length <= Bytes.length buffer -> 133 | sentinel 134 | | _ -> 135 | let sentinel = { offset = 0; buffer = Bytes.create length_delimited_size_field_length; } in 136 | t.data <- sentinel :: t.data; 137 | sentinel 138 | in 139 | let offset = sentinel.offset in 140 | (* Ensure no writes to the sentinel *) 141 | sentinel.offset <- Int.max_int; 142 | let _ = write t v in 143 | let size = size_data_added sentinel 0 t.data in 144 | let offset = write_varint_unboxed sentinel.buffer ~offset size in 145 | sentinel.offset <- offset; 146 | () 147 | in 148 | let write_speed v t = 149 | let sentinel = ensure_capacity ~size:length_delimited_size_field_length t in 150 | let offset = sentinel.offset in 151 | sentinel.offset <- sentinel.offset + length_delimited_size_field_length; 152 | let _ = write t v in 153 | let size = size_data_added sentinel (sentinel.offset - (offset + length_delimited_size_field_length)) t.data in 154 | let _ = write_delimited_field_length_fixed_size sentinel.buffer ~offset size in 155 | () 156 | in 157 | let write_space v t = 158 | let sentinel = ensure_capacity ~size:length_delimited_size_field_length t in 159 | let offset = sentinel.offset in 160 | sentinel.offset <- sentinel.offset + length_delimited_size_field_length; 161 | let _ = write t v in 162 | let size = size_data_added sentinel (sentinel.offset - (offset + length_delimited_size_field_length)) t.data in 163 | let offset' = write_varint_unboxed sentinel.buffer ~offset size in 164 | (* Move data to avoid holes *) 165 | let () = match (offset + length_delimited_size_field_length = offset') with 166 | | true -> () 167 | | false -> 168 | Bytes.blit ~src:sentinel.buffer ~src_pos:(offset + length_delimited_size_field_length) 169 | ~dst:sentinel.buffer ~dst_pos:offset' 170 | ~len:(sentinel.offset - (offset + length_delimited_size_field_length)); 171 | sentinel.offset <- sentinel.offset - (offset+length_delimited_size_field_length-offset'); 172 | in 173 | () 174 | in 175 | match t.mode with 176 | | Balanced -> write_balanced v t 177 | | Speed -> write_speed v t 178 | | Space -> write_space v t 179 | 180 | let contents t = 181 | let size = size t in 182 | let contents = Bytes.create size in 183 | let rec inner offset = function 184 | | [] -> offset 185 | | { offset = o; buffer} :: tl -> 186 | let next_offset = offset - o in 187 | Bytes.blit ~src:buffer ~src_pos:0 ~dst:contents ~dst_pos:next_offset ~len:o; 188 | inner (next_offset) tl 189 | in 190 | let offset = inner size t.data in 191 | assert (offset = 0); 192 | Bytes.unsafe_to_string contents 193 | 194 | let dump t = 195 | let string_contents = contents t in 196 | List.init ~len:(String.length string_contents) ~f:(fun i -> 197 | Printf.sprintf "%02x" (Char.code (String.get string_contents i)) 198 | ) 199 | |> String.concat ~sep:"-" 200 | |> Printf.printf "Buffer: %s\n" 201 | 202 | let string_of_bytes b = 203 | Bytes.to_seq b |> Seq.map Char.code |> Seq.map (Printf.sprintf "%02x") |> List.of_seq |> String.concat ~sep:" " 204 | 205 | let of_list: (int * Field.t) list -> t = fun fields -> 206 | let t = init () in 207 | List.iter ~f:(fun (index, field) -> write_field t index field) fields; 208 | t 209 | 210 | let%expect_test "Writefield" = 211 | let buffer = init () in 212 | write_field buffer 1 (Varint 3L); 213 | write_field buffer 2 (Varint 5L); 214 | write_field buffer 3 (Varint 7L); 215 | write_field buffer 4 (Varint 11L); 216 | dump buffer; 217 | [%expect {| Buffer: 08-03-10-05-18-07-20-0b |}] 218 | 219 | let%expect_test "fixed_size" = 220 | List.iter ~f:(fun v -> 221 | let buffer = Bytes.make 10 '\255' in 222 | let _ = write_delimited_field_length_fixed_size buffer ~offset:0 v in 223 | Printf.printf "Fixed field: 0x%08x: %s\n" v (string_of_bytes buffer); 224 | ) [0;1;2;0x7fffffff; 0x3fffffff]; 225 | (); 226 | [%expect {| 227 | Fixed field: 0x00000000: 80 80 80 80 00 ff ff ff ff ff 228 | Fixed field: 0x00000001: 81 80 80 80 00 ff ff ff ff ff 229 | Fixed field: 0x00000002: 82 80 80 80 00 ff ff ff ff ff 230 | Fixed field: 0x7fffffff: ff ff ff ff 07 ff ff ff ff ff 231 | Fixed field: 0x3fffffff: ff ff ff ff 03 ff ff ff ff ff |}] 232 | 233 | 234 | let%test "varint" = 235 | let open Infix.Int64 in 236 | let string_of_bytes b = 237 | Bytes.to_seq b |> Seq.map Char.code |> Seq.map (Printf.sprintf "%02x") |> List.of_seq |> String.concat ~sep:" " 238 | in 239 | let values = List.init ~len:64 ~f:(fun idx -> 1L lsl idx) @ 240 | List.init ~len:64 ~f:(fun idx -> (-1L) lsl idx) 241 | in 242 | List.fold_left ~init:true ~f:(fun acc v -> 243 | List.fold_left ~init:acc ~f:(fun acc v -> 244 | let b1 = Bytes.make 10 '\000' in 245 | let b2 = Bytes.make 10 '\000' in 246 | write_varint_unboxed b1 ~offset:0 (Int64.to_int v) |> ignore; 247 | write_varint b2 ~offset:0 (v) |> ignore; 248 | match Bytes.equal b1 b2 || Int64.shift_right_logical v 63 != 0L with 249 | | true -> acc 250 | | false -> 251 | Printf.printf "Unboxed: %16Lx (%20d): %S = %S\n" v (Int64.to_int v) (string_of_bytes b1) (string_of_bytes b2); 252 | false 253 | ) [v-2L; v-1L; v; v+1L; v+2L] 254 | ) values 255 | -------------------------------------------------------------------------------- /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 256. 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_value': write:(t -> 'a -> _) -> '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 | 3 | type t = { 4 | mutable indent : string; 5 | mutable code : string list; 6 | } 7 | 8 | let init () = {indent = ""; code = []} 9 | let incr t = t.indent <- " " ^ t.indent 10 | let decr t = 11 | match String.length t.indent >= 2 with 12 | | true -> 13 | t.indent <- String.sub ~pos:0 ~len:(String.length t.indent - 2) t.indent 14 | | false -> failwith "Cannot decr indentation level at this point" 15 | 16 | let emit t indent fmt = 17 | let trim_end ~char s = 18 | let len = String.length s in 19 | let rcount s = 20 | let rec inner = function 21 | | 0 -> len 22 | | n when s.[n - 1] = char -> inner (n - 1) 23 | | n -> len - n 24 | in 25 | inner len 26 | in 27 | match rcount s with 28 | | 0 -> s 29 | | n -> String.sub ~pos:0 ~len:(String.length s - n) s 30 | in 31 | let prepend s = 32 | String.split_on_char ~sep:'\n' s 33 | |> List.iter ~f:(fun s -> t.code <- (trim_end ~char:' ' (t.indent ^ s)) :: t.code) 34 | in 35 | let emit s = 36 | match indent with 37 | | `Begin -> 38 | prepend s; 39 | incr t 40 | | `None -> 41 | prepend s 42 | | `End -> 43 | decr t; 44 | prepend s 45 | | `EndBegin -> 46 | decr t; 47 | prepend s; 48 | incr t 49 | in 50 | Printf.ksprintf emit fmt 51 | 52 | let append t code = List.iter ~f:(emit t `None "%s") (code.code |> List.rev) 53 | 54 | let contents t = 55 | List.map ~f:(Printf.sprintf "%s") (List.rev t.code) 56 | |> String.concat ~sep:"\n" 57 | -------------------------------------------------------------------------------- /src/plugin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name protoc_gen_ocaml) 3 | (public_name protoc-gen-ocaml) 4 | (libraries spec) 5 | (package ocaml-protoc-plugin) 6 | ) 7 | -------------------------------------------------------------------------------- /src/plugin/emit.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | open Parameters 3 | open Spec.Descriptor.Google.Protobuf 4 | 5 | module IntSet = Set.Make(struct type t = int let compare = compare end) 6 | let sprintf = Printf.sprintf 7 | 8 | (** Slightly overloaded name here. 9 | Its also used for all other types which would go into a module *) 10 | type module' = { 11 | module_name : string; 12 | signature : Code.t; 13 | implementation : Code.t; 14 | } 15 | 16 | (* Enums are not mangled - Maybe they should be lowercased though. *) 17 | let emit_enum_type ~scope ~params 18 | EnumDescriptorProto.{name; value = values; options = _; reserved_range = _; reserved_name = _} 19 | : module' = 20 | let name = Option.value_exn ~message:"Enums must have a name" name in 21 | let module_name = Scope.get_name scope name in 22 | let signature = Code.init () in 23 | let implementation = Code.init () in 24 | let scope = Scope.push scope name in 25 | let t = Code.init () in 26 | Code.emit t `None "type t = %s %s" 27 | (List.map ~f:(fun EnumValueDescriptorProto.{name; _} -> Scope.get_name_exn scope name) values 28 | |> String.concat ~sep:" | " 29 | ) 30 | params.Parameters.annot; 31 | Code.append signature t; 32 | Code.append implementation t; 33 | Code.emit signature `None "val to_int: t -> int"; 34 | Code.emit signature `None "val from_int: int -> t Runtime'.Result.t"; 35 | Code.emit signature `None "val from_int_exn: int -> t"; 36 | 37 | Code.emit implementation `Begin "let to_int = function"; 38 | List.iter ~f:(fun EnumValueDescriptorProto.{name; number; _} -> 39 | Code.emit implementation `None "| %s -> %d" (Scope.get_name_exn scope name) (Option.value_exn number) 40 | ) values; 41 | Code.emit implementation `End ""; 42 | Code.emit implementation `Begin "let from_int_exn = function"; 43 | let _ = 44 | List.fold_left ~init:IntSet.empty ~f:(fun seen EnumValueDescriptorProto.{name; number; _} -> 45 | let idx = (Option.value_exn ~message:"All enum descriptions must have a value" number) in 46 | match IntSet.mem idx seen with 47 | | true -> seen 48 | | false -> 49 | Code.emit implementation `None "| %d -> %s" idx (Scope.get_name_exn scope name); 50 | IntSet.add idx seen 51 | ) values 52 | in 53 | Code.emit implementation `None "| n -> Runtime'.Result.raise (`Unknown_enum_value n)"; 54 | Code.emit implementation `End ""; 55 | Code.emit implementation `Begin "let from_int e = Runtime'.Result.catch (fun () -> from_int_exn e)"; 56 | 57 | {module_name; signature; implementation} 58 | 59 | let emit_service_type ~options scope ServiceDescriptorProto.{ name; method' = methods; _ } = 60 | let emit_method signature implementation local_scope scope service_name MethodDescriptorProto.{ name; input_type; output_type; _} = 61 | let name = Option.value_exn name in 62 | let mangle_f = match Scope.has_mangle_option options with 63 | | false -> fun id -> id 64 | | true -> Names.to_snake_case 65 | in 66 | let uncapitalized_name = mangle_f name |> String.uncapitalize_ascii |> Scope.Local.get_unique_name local_scope in 67 | (* To keep symmetry, only ensure that lowercased names are unique 68 | so that the upper case names are aswell. We should remove this 69 | mapping if/when we deprecate the old API *) 70 | let capitalized_name = String.capitalize_ascii uncapitalized_name in 71 | 72 | let package_name_opt = Scope.get_package_name scope in 73 | let package_name = 74 | match package_name_opt with 75 | | None -> "" 76 | | Some p -> p ^ "." 77 | in 78 | let input = Scope.get_scoped_name scope input_type in 79 | let input_t = Scope.get_scoped_name scope ~postfix:"t" input_type in 80 | let output = Scope.get_scoped_name scope output_type in 81 | let output_t = Scope.get_scoped_name scope ~postfix:"t" output_type in 82 | let sig_t = sprintf "Runtime'.Service.Rpc with type Request.t = %s and type Response.t = %s" input_t output_t in 83 | Code.emit implementation `Begin "module %s : %s = struct" capitalized_name sig_t; 84 | Code.emit implementation `None "let package_name = %s" (Option.value_map ~default:"None" ~f:(fun n -> sprintf "Some \"%s\"" n) package_name_opt); 85 | Code.emit implementation `None "let service_name = \"%s\"" service_name; 86 | Code.emit implementation `None "let method_name = \"%s\"" name; 87 | Code.emit implementation `None "let name = \"/%s%s/%s\"" package_name service_name name; 88 | Code.emit implementation `None "module Request = %s" input; 89 | Code.emit implementation `None "module Response = %s" output; 90 | Code.emit implementation `End "end"; 91 | let sig_t' = 92 | sprintf "(module Runtime'.Service.Message with type t = %s) * (module Runtime'.Service.Message with type t = %s)" input_t output_t 93 | in 94 | Code.emit implementation `Begin "let %s : %s = " uncapitalized_name sig_t'; 95 | Code.emit implementation `None "(module %s : Runtime'.Service.Message with type t = %s ), " 96 | input 97 | input_t; 98 | Code.emit implementation `None "(module %s : Runtime'.Service.Message with type t = %s )" 99 | output 100 | output_t; 101 | Code.emit implementation `End ""; 102 | 103 | Code.emit signature `None "module %s : %s" capitalized_name sig_t; 104 | Code.emit signature `None "val %s : %s" uncapitalized_name sig_t'; 105 | () 106 | in 107 | let name = Option.value_exn ~message:"Service definitions must have a name" name in 108 | let signature = Code.init () in 109 | let implementation = Code.init () in 110 | Code.emit signature `Begin "module %s : sig" (Scope.get_name scope name); 111 | Code.emit implementation `Begin "module %s = struct" (Scope.get_name scope name); 112 | let local_scope = Scope.Local.init () in 113 | 114 | List.iter ~f:(emit_method signature implementation local_scope (Scope.push scope name) name) methods; 115 | Code.emit signature `End "end"; 116 | Code.emit implementation `End "end"; 117 | signature, implementation 118 | 119 | let emit_extension ~scope ~params field = 120 | let FieldDescriptorProto.{ name; extendee; _ } = field in 121 | let name = Option.value_exn ~message:"Extensions must have a name" name in 122 | let module_name = (Scope.get_name scope name) in 123 | let extendee_type = Scope.get_scoped_name scope ~postfix:"t" extendee in 124 | let extendee_field = Scope.get_scoped_name scope ~postfix:"extensions'" extendee in 125 | (* Get spec and type *) 126 | let c = 127 | let params = Parameters.{params with singleton_record = false} in 128 | Types.spec_of_field ~params ~syntax:`Proto2 ~scope field 129 | in 130 | let signature = Code.init () in 131 | let implementation = Code.init () in 132 | Code.append implementation signature; 133 | 134 | Code.emit signature `None "type t = %s %s" c.typestr params.annot; 135 | Code.emit signature `None "val get_exn: %s -> %s" extendee_type c.typestr; 136 | Code.emit signature `None "val get: %s -> (%s, [> Runtime'.Result.error]) result" extendee_type c.typestr; 137 | Code.emit signature `None "val set: %s -> %s -> %s" extendee_type c.typestr extendee_type; 138 | 139 | Code.emit implementation `None "type t = %s %s" c.typestr params.annot; 140 | Code.emit implementation `None "let get_exn extendee = Runtime'.Extensions.get Runtime'.Deserialize.C.(%s) (extendee.%s)" c.deserialize_spec extendee_field ; 141 | Code.emit implementation `None "let get extendee = Runtime'.Result.catch (fun () -> get_exn extendee)"; 142 | Code.emit implementation `Begin "let set extendee t ="; 143 | Code.emit implementation `None "let extensions' = Runtime'.Extensions.set Runtime'.Serialize.C.(%s) (extendee.%s) t in" c.serialize_spec extendee_field; 144 | Code.emit implementation `None "{ extendee with %s = extensions' }" extendee_field; 145 | Code.emit implementation `End ""; 146 | { module_name; signature; implementation } 147 | 148 | let is_map_entry = function 149 | | Some MessageOptions.{ map_entry = Some true; _ } -> true 150 | | _ -> false 151 | 152 | (** Emit the nested types. *) 153 | let emit_sub dest ~is_implementation ~is_first {module_name; signature; implementation} = 154 | let () = 155 | match is_first with 156 | | true -> Code.emit dest `Begin "module rec %s : sig" module_name 157 | | false -> Code.emit dest `Begin "and %s : sig" module_name 158 | in 159 | Code.append dest signature; 160 | let () = 161 | match is_implementation with 162 | | false -> () 163 | | true -> 164 | Code.emit dest `EndBegin "end = struct "; 165 | Code.append dest implementation 166 | in 167 | Code.emit dest `End "end"; 168 | () 169 | 170 | let rec emit_nested_types ~syntax ~signature ~implementation ?(is_first = true) nested_types = 171 | match nested_types with 172 | | [] -> () 173 | | sub :: subs -> 174 | emit_sub ~is_implementation:false signature ~is_first sub; 175 | emit_sub ~is_implementation:true implementation ~is_first sub; 176 | emit_nested_types ~syntax ~signature ~implementation ~is_first:false subs 177 | 178 | (* Emit a message plus all its subtypes. 179 | Why is this not being called recursively, but rather calling sub functions which never returns 180 | *) 181 | let rec emit_message ~params ~syntax scope 182 | DescriptorProto.{ name; field = fields; extension = extensions; 183 | nested_type = nested_types; enum_type = enum_types; 184 | extension_range = extension_ranges; oneof_decl = oneof_decls; options; 185 | reserved_range = _; reserved_name = _ } : module' = 186 | 187 | let signature = Code.init () in 188 | let implementation = Code.init () in 189 | 190 | let has_extensions = not (extension_ranges = []) in 191 | (* Ignore empty modules *) 192 | let module_name, scope = 193 | match name with 194 | | None -> "", scope 195 | | Some name -> 196 | let module_name = Scope.get_name scope name in 197 | module_name, Scope.push scope name 198 | in 199 | List.map ~f:(emit_enum_type ~scope ~params) enum_types 200 | @ List.map ~f:(emit_message ~params ~syntax scope) nested_types 201 | @ List.map ~f:(emit_extension ~scope ~params) extensions 202 | |> emit_nested_types ~syntax ~signature ~implementation; 203 | 204 | let () = 205 | match name with 206 | | Some _name -> 207 | let is_map_entry = is_map_entry options in 208 | let is_cyclic = Scope.is_cyclic scope in 209 | let extension_ranges = 210 | extension_ranges 211 | |> List.map ~f:(function 212 | | DescriptorProto.ExtensionRange.{ start = Some start; end' = Some end'; _ } -> (start, end') 213 | | _ -> failwith "Extension ranges must be defined" 214 | ) 215 | |> List.map ~f:(fun (s, e) -> sprintf "(%d, %d)" s e) 216 | |> String.concat ~sep:"; " 217 | |> sprintf "[%s]" 218 | in 219 | let Types.{ type'; constructor; apply; deserialize_spec; serialize_spec; default_constructor_sig; default_constructor_impl } = 220 | Types.make ~params ~syntax ~is_cyclic ~is_map_entry ~has_extensions ~scope ~fields oneof_decls 221 | in 222 | ignore (default_constructor_sig, default_constructor_impl); 223 | 224 | Code.emit signature `None "val name': unit -> string"; 225 | Code.emit signature `None "type t = %s %s" type' params.annot; 226 | Code.emit signature `None "val make : %s" default_constructor_sig; 227 | Code.emit signature `None "val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t"; 228 | Code.emit signature `None "val to_proto: t -> Runtime'.Writer.t"; 229 | Code.emit signature `None "val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result"; 230 | Code.emit signature `None "val from_proto_exn: Runtime'.Reader.t -> t"; 231 | 232 | Code.emit implementation `None "let name' () = \"%s\"" (Scope.get_current_scope scope); 233 | Code.emit implementation `None "type t = %s%s" type' params.annot; 234 | Code.emit implementation `None "let make %s" default_constructor_impl; 235 | 236 | Code.emit implementation `Begin "let to_proto' ="; 237 | Code.emit implementation `None "let apply = %s in" apply; 238 | Code.emit implementation `None "let spec = %s in" serialize_spec; 239 | Code.emit implementation `None "let serialize = Runtime'.Serialize.serialize %s spec in" extension_ranges; 240 | Code.emit implementation `None "fun writer t -> apply ~f:serialize writer t"; 241 | Code.emit implementation `End ""; 242 | Code.emit implementation `Begin "let to_proto t = to_proto' (Runtime'.Writer.init ()) t"; 243 | Code.emit implementation `End ""; 244 | 245 | 246 | Code.emit implementation `Begin "let from_proto_exn ="; 247 | Code.emit implementation `None "let constructor = %s in" constructor; 248 | Code.emit implementation `None "let spec = %s in" deserialize_spec; 249 | Code.emit implementation `None "let deserialize = Runtime'.Deserialize.deserialize %s spec constructor in" extension_ranges; 250 | Code.emit implementation `None "fun writer -> deserialize writer"; 251 | 252 | Code.emit implementation `None "let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer)"; 253 | Code.emit implementation `End ""; 254 | | None -> () 255 | in 256 | {module_name; signature; implementation} 257 | 258 | let rec wrap_packages ~params ~syntax ~options scope message_type services = function 259 | | [] -> 260 | let { module_name = _; implementation; signature } = emit_message ~params ~syntax scope message_type in 261 | List.iter ~f:(fun service -> 262 | let signature', implementation' = emit_service_type ~options scope service in 263 | Code.append implementation implementation'; 264 | Code.append signature signature'; 265 | () 266 | ) services; 267 | signature, implementation 268 | 269 | | package :: packages -> 270 | let signature = Code.init () in 271 | let implementation = Code.init () in 272 | let package_name = Scope.get_name scope package in 273 | let scope = Scope.push scope package in 274 | 275 | let signature', implementation' = 276 | wrap_packages ~params ~syntax ~options scope message_type services packages 277 | in 278 | 279 | Code.emit implementation `Begin "module rec %s : sig" package_name; 280 | Code.append implementation signature'; 281 | Code.emit implementation `EndBegin "end = struct"; 282 | Code.append implementation implementation'; 283 | Code.emit implementation `End "end"; 284 | Code.emit signature `Begin "module rec %s : sig" package_name; 285 | Code.append signature signature'; 286 | Code.emit signature `End "end"; 287 | 288 | signature, implementation 289 | 290 | let emit_header implementation ~name ~syntax ~params = 291 | Code.emit implementation `None "(************************************************)"; 292 | Code.emit implementation `None "(* AUTOGENERATED FILE - DO NOT EDIT! *)"; 293 | Code.emit implementation `None "(************************************************)"; 294 | Code.emit implementation `None "(* Generated by: ocaml-protoc-plugin *)"; 295 | Code.emit implementation `None "(* https://github.com/issuu/ocaml-protoc-plugin *)"; 296 | Code.emit implementation `None "(************************************************)"; 297 | Code.emit implementation `None "(*"; 298 | Code.emit implementation `None " Source: %s" name; 299 | Code.emit implementation `None " Syntax: %s" (match syntax with `Proto2 -> "proto2" | `Proto3 -> "proto3"); 300 | Code.emit implementation `None " Parameters:"; 301 | Code.emit implementation `None " debug=%b" params.debug; 302 | Code.emit implementation `None " annot='%s'" params.annot; 303 | Code.emit implementation `None " opens=[%s]" (String.concat ~sep:"; " params.opens); 304 | Code.emit implementation `None " int64_as_int=%b" params.int64_as_int; 305 | Code.emit implementation `None " int32_as_int=%b" params.int32_as_int; 306 | Code.emit implementation `None " fixed_as_int=%b" params.fixed_as_int; 307 | Code.emit implementation `None " singleton_record=%b" params.singleton_record; 308 | Code.emit implementation `None "*)"; 309 | Code.emit implementation `None ""; 310 | () 311 | 312 | let parse_proto_file ~params scope 313 | FileDescriptorProto.{ name; package; dependency = dependencies; public_dependency = _; 314 | weak_dependency = _; message_type = message_types; 315 | enum_type = enum_types; service = services; extension; 316 | options; source_code_info = _; syntax; } 317 | = 318 | let name = Option.value_exn ~message:"All files must have a name" name |> String.map ~f:(function '-' -> '_' | c -> c) in 319 | let syntax = match syntax with 320 | | None | Some "proto2" -> `Proto2 321 | | Some "proto3" -> `Proto3 322 | | _ -> failwith "Unsupported syntax" 323 | in 324 | let message_type = 325 | DescriptorProto.{name = None; nested_type=message_types; enum_type = enum_types; 326 | field = []; extension; extension_range = []; oneof_decl = []; 327 | options = None; reserved_range = []; reserved_name = []; } 328 | in 329 | let implementation = Code.init () in 330 | emit_header implementation ~name ~syntax ~params; 331 | Code.emit implementation `None "open Ocaml_protoc_plugin.Runtime [@@warning \"-33\"]"; 332 | List.iter ~f:(Code.emit implementation `None "open %s [@@warning \"-33\"]" ) params.opens; 333 | let _ = match dependencies with 334 | | [] -> () 335 | | dependencies -> 336 | Code.emit implementation `None "(**/**)"; 337 | Code.emit implementation `Begin "module %s = struct" Scope.import_module_name; 338 | List.iter ~f:(fun proto_file -> 339 | let module_name = Scope.module_name_of_proto proto_file in 340 | Code.emit implementation `None "module %s = %s" module_name module_name; 341 | ) dependencies; 342 | Code.emit implementation `End "end"; 343 | Code.emit implementation `None "(**/**)"; 344 | in 345 | let _signature', implementation' = 346 | wrap_packages ~params ~syntax ~options scope message_type services (Option.value_map ~default:[] ~f:(String.split_on_char ~sep:'.') package) 347 | in 348 | 349 | Code.append implementation implementation'; 350 | Code.emit implementation `None ""; 351 | 352 | let base_name = Filename.remove_extension name in 353 | (base_name ^ ".ml"), implementation 354 | -------------------------------------------------------------------------------- /src/plugin/emit.mli: -------------------------------------------------------------------------------- 1 | open Spec.Descriptor.Google.Protobuf 2 | val parse_proto_file: 3 | params:Parameters.t -> 4 | Scope.t -> FileDescriptorProto.t -> string * Code.t 5 | -------------------------------------------------------------------------------- /src/plugin/names.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | 3 | type char_type = Lower | Upper | Neither 4 | 5 | (** Taken from: https://caml.inria.fr/pub/docs/manual-ocaml/lex.html *) 6 | let is_reserved = function 7 | | "and" | "as" | "assert" | "asr" | "begin" | "class" | "constraint" | "do" | "done" 8 | | "downto" | "else" | "end" | "exception" | "external" | "false" | "for" | "fun" 9 | | "function" | "functor" | "if" | "in" | "include" | "inherit" | "initializer" 10 | | "land" | "lazy" | "let" | "lor" | "lsl" | "lsr" | "lxor" | "match" | "method" 11 | | "mod" | "module" | "mutable" | "new" | "nonrec" | "object" | "of" | "open" | "or" 12 | | "private" | "rec" | "sig" | "struct" | "then" | "to" | "true" | "try" | "type" 13 | | "val" | "virtual" | "when" | "while" | "with" -> true 14 | | _ -> false 15 | 16 | let to_snake_case ident = 17 | let to_list s = 18 | let r = ref [] in 19 | String.iter ~f:(fun c -> r := c :: !r) s; 20 | List.rev !r 21 | in 22 | let to_string l = 23 | let bytes = Bytes.create (List.length l) in 24 | List.iteri ~f:(fun i c -> Bytes.set bytes i c) l; 25 | Bytes.to_string bytes 26 | in 27 | let char_case = function 28 | | 'a' .. 'z' -> Lower 29 | | 'A' .. 'Z' -> Upper 30 | | _ -> Neither 31 | in 32 | let is_lower c = char_case c = Lower in 33 | let is_upper c = char_case c = Upper in 34 | 35 | let rec to_snake_case = function 36 | | c1 :: c2 :: cs when is_lower c1 && is_upper c2 -> 37 | c1 :: '_' :: c2 :: to_snake_case cs 38 | | c1 :: cs -> 39 | c1 :: (to_snake_case cs) 40 | | [] -> [] 41 | in 42 | to_list ident 43 | |> to_snake_case 44 | |> to_string 45 | |> String.lowercase_ascii 46 | |> String.capitalize_ascii 47 | 48 | let field_name ?(mangle_f=(fun x -> x)) field_name = 49 | match String.uncapitalize_ascii (mangle_f field_name) with 50 | | name when is_reserved name -> name ^ "'" 51 | | name -> name 52 | 53 | let module_name ?(mangle_f=(fun x -> x)) name = 54 | let name = mangle_f name in 55 | match name.[0] with 56 | | '_' -> "P" ^ name 57 | | _ -> String.capitalize_ascii name 58 | 59 | let poly_constructor_name ?(mangle_f=(fun x -> x)) name = 60 | "`" ^ (mangle_f name |> String.capitalize_ascii) 61 | -------------------------------------------------------------------------------- /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 none = None 31 | -------------------------------------------------------------------------------- /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 | } 12 | 13 | let default = { 14 | annot = ""; 15 | opens = []; 16 | int64_as_int = true; 17 | int32_as_int = true; 18 | fixed_as_int = false; 19 | debug = false; 20 | singleton_record = false; 21 | } 22 | 23 | let parse_option str = 24 | match String.index str '=' with 25 | | n -> `Expr (String.sub str ~pos:0 ~len:n, String.sub str ~pos:(n + 1) ~len:(String.length str - n - 1)) 26 | | exception Not_found -> `Stmt str 27 | 28 | let parse parameters = 29 | String.split_on_char ~sep:';' parameters 30 | |> List.fold_left ~init:default ~f:(fun param option -> 31 | match parse_option option with 32 | | `Expr ("annot", annot) -> { param with annot } 33 | | `Expr ("open", open') -> { param with opens = param.opens @ [open'] } 34 | | `Stmt "use_int32" -> { param with int32_as_int = false } 35 | | `Stmt "use_int64" -> { param with int64_as_int = false } 36 | | `Expr ("fixed_as_int", (("true"|"false") as v)) -> { param with fixed_as_int = (bool_of_string v) }; 37 | | `Expr ("int64_as_int", (("true"|"false") as v)) -> { param with int64_as_int = (bool_of_string v) }; 38 | | `Expr ("int32_as_int", (("true"|"false") as v)) -> { param with int32_as_int = (bool_of_string v) }; 39 | | `Expr ("singleton_record", (("true"|"false") as v)) -> { param with singleton_record = (bool_of_string v) }; 40 | | `Stmt "debug" -> { param with debug = true} 41 | | `Stmt "" -> param 42 | | _ -> failwith ("Unknown parameter: " ^ option) 43 | ) 44 | 45 | let use_snakecase options = 46 | Option.bind ~f:(fun option -> 47 | Spec.Options.Ocaml_options.get option 48 | |> Ocaml_protoc_plugin.Result.get ~msg:"Could not parse ocaml options" 49 | ) options 50 | |> Option.value ~default:false 51 | -------------------------------------------------------------------------------- /src/plugin/parse.ml: -------------------------------------------------------------------------------- 1 | (* Should we generate an ast???? 2 | It would be simpler, and then generate the code based on that one 3 | The question is if this is actually harder than just parsing and emitting OTOH: Its easier to create interfaces and modules once we know all the types. 4 | We also need to do a lexiographic ordering. No I dont!!! 5 | *) 6 | 7 | type t = { 8 | filename : string; 9 | package : string option; 10 | } 11 | -------------------------------------------------------------------------------- /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 | (* Find the correct file to process *) 34 | let target_proto_files = List.filter ~f:(fun Descriptor.FileDescriptorProto.{name; _} -> 35 | List.mem ~set:files_to_generate (Option.value_exn name) 36 | ) proto_files 37 | in 38 | let scope = Scope.init proto_files in 39 | let result = 40 | List.map ~f:(fun (proto_file : Descriptor.FileDescriptorProto.t) -> 41 | let scope = Scope.for_descriptor scope proto_file in 42 | Emit.parse_proto_file ~params scope proto_file 43 | ) target_proto_files 44 | |> List.map ~f:(fun (name, code) -> 45 | (Filename.basename name, code) 46 | ) 47 | in 48 | (match params.debug with 49 | | true -> List.iter ~f:(fun (_, code) -> Printf.eprintf "%s\n%!" (Code.contents code)) result 50 | | false -> ()); 51 | result 52 | 53 | let () = 54 | let request = read () in 55 | let outputs = parse_request request in 56 | let response_of_output (name, code) = 57 | Plugin.CodeGeneratorResponse.File.make ~name ~content:(Code.contents code) () 58 | in 59 | let response : Plugin.CodeGeneratorResponse.t = 60 | Plugin.CodeGeneratorResponse.make ~supported_features:1 ~file:(List.map ~f:response_of_output outputs) () 61 | in 62 | write response 63 | -------------------------------------------------------------------------------- /src/plugin/scope.mli: -------------------------------------------------------------------------------- 1 | module Local : sig 2 | type t 3 | val init: unit -> t 4 | val get_unique_name: t -> string -> string 5 | end 6 | 7 | type t 8 | val init : Spec.Descriptor.Google.Protobuf.FileDescriptorProto.t list -> t 9 | 10 | val for_descriptor: t -> Spec.Descriptor.Google.Protobuf.FileDescriptorProto.t -> t 11 | 12 | (** Push an identifier to the current scope *) 13 | val push : t -> string -> t 14 | 15 | (** Get the module name of a proto file *) 16 | val module_name_of_proto: string -> string 17 | 18 | (** The import module name - Must be globally unique *) 19 | val import_module_name: string 20 | 21 | (** Get the ocaml name of the given proto type name, based on the current scope *) 22 | val get_scoped_name : ?postfix:string -> t -> string option -> string 23 | 24 | (** Get the ocaml name of the default enum *) 25 | val get_scoped_enum_name : t -> string option -> string 26 | 27 | (** Get the ocaml name of the given proto type name, based on the current scope *) 28 | val get_name : t -> string -> string 29 | 30 | (** Get the ocaml name of the given proto type name, based on the current scope *) 31 | val get_name_exn : t -> string option -> string 32 | 33 | (** Get the type of the curren scope *) 34 | val get_current_scope : t -> string 35 | 36 | (** Get the package name. This function assumes callee is in service scope *) 37 | val get_package_name : t -> string option 38 | 39 | (** Tell if the type pointed to by the current scope is part of a cycle. *) 40 | val is_cyclic: t -> bool 41 | 42 | (** Test is the options specify name mangling *) 43 | val has_mangle_option: Spec.Descriptor.Google.Protobuf.FileOptions.t option -> bool 44 | 45 | (** Get stringified version of the current proto path *) 46 | val get_proto_path: t -> string 47 | -------------------------------------------------------------------------------- /src/plugin/types.mli: -------------------------------------------------------------------------------- 1 | open Spec.Descriptor.Google.Protobuf 2 | 3 | type t = { 4 | type' : string; 5 | constructor: string; 6 | apply: string; 7 | deserialize_spec: string; 8 | serialize_spec: string; 9 | default_constructor_sig: string; 10 | default_constructor_impl: string; 11 | } 12 | 13 | type field_spec = { 14 | typestr : string; 15 | serialize_spec: string; 16 | deserialize_spec: string; 17 | } 18 | 19 | val spec_of_field: 20 | params:Parameters.t -> 21 | syntax:[ `Proto2 | `Proto3 ] -> 22 | scope:Scope.t -> FieldDescriptorProto.t -> field_spec 23 | 24 | val make: 25 | params:Parameters.t -> 26 | syntax:[ `Proto2 | `Proto3 ] -> 27 | is_cyclic: bool -> 28 | is_map_entry: bool -> 29 | has_extensions: bool -> 30 | scope:Scope.t -> 31 | fields:FieldDescriptorProto.t list -> OneofDescriptorProto.t list -> t 32 | -------------------------------------------------------------------------------- /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/issuu/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 | *) 19 | 20 | open Ocaml_protoc_plugin.Runtime [@@warning "-33"] 21 | (**/**) 22 | module Imported'modules = struct 23 | module Descriptor = Descriptor 24 | end 25 | (**/**) 26 | module rec Options : sig 27 | val name': unit -> string 28 | type t = bool 29 | val make : ?mangle_names:bool -> unit -> t 30 | val to_proto': Runtime'.Writer.t -> t -> Runtime'.Writer.t 31 | val to_proto: t -> Runtime'.Writer.t 32 | val from_proto: Runtime'.Reader.t -> (t, [> Runtime'.Result.error]) result 33 | val from_proto_exn: Runtime'.Reader.t -> t 34 | end = struct 35 | let name' () = "options.Options" 36 | type t = bool 37 | let make ?(mangle_names = false) () = mangle_names 38 | let to_proto' = 39 | let apply = fun ~f:f' writer mangle_names -> f' [] writer mangle_names in 40 | let spec = Runtime'.Serialize.C.( basic (1, bool, Some (false)) ^:: nil ) in 41 | let serialize = Runtime'.Serialize.serialize [] spec in 42 | fun writer t -> apply ~f:serialize writer t 43 | 44 | let to_proto t = to_proto' (Runtime'.Writer.init ()) t 45 | 46 | let from_proto_exn = 47 | let constructor = fun mangle_names _extensions -> mangle_names in 48 | let spec = Runtime'.Deserialize.C.( basic (1, bool, Some (false)) ^:: nil ) in 49 | let deserialize = Runtime'.Deserialize.deserialize [] spec constructor in 50 | fun writer -> deserialize writer 51 | let from_proto writer = Runtime'.Result.catch (fun () -> from_proto_exn writer) 52 | 53 | end 54 | and Ocaml_options : sig 55 | type t = Options.t option 56 | val get_exn: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> Options.t option 57 | val get: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> (Options.t option, [> Runtime'.Result.error]) result 58 | val set: Imported'modules.Descriptor.Google.Protobuf.FileOptions.t -> Options.t option -> Imported'modules.Descriptor.Google.Protobuf.FileOptions.t 59 | end = struct 60 | type t = Options.t option 61 | let get_exn extendee = Runtime'.Extensions.get Runtime'.Deserialize.C.(basic_opt (1074, (message (fun t -> Options.from_proto_exn t)))) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') 62 | let get extendee = Runtime'.Result.catch (fun () -> get_exn extendee) 63 | let set extendee t = 64 | let extensions' = Runtime'.Extensions.set Runtime'.Serialize.C.(basic_opt (1074, (message (fun t -> Options.to_proto' t)))) (extendee.Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions') t in 65 | { extendee with Imported'modules.Descriptor.Google.Protobuf.FileOptions.extensions' = extensions' } 66 | 67 | end 68 | -------------------------------------------------------------------------------- /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 | 2 | syntax = "proto3"; 3 | 4 | package protoc.plugin.test; 5 | 6 | message Message { 7 | int32 payload = 1; 8 | } 9 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | 2 | ;; Determine if the compiler supports the --experimental_allow_proto3_optional flag. 3 | ;; The output file will be non-empty if the flag is supported 4 | (subdir config 5 | (rule 6 | (target support_proto3_optional.conf) 7 | (action (with-accepted-exit-codes (or 0 1) (ignore-stderr (with-stdout-to %{target} (run protoc --experimental_allow_proto3_optional --version))))))) 8 | 9 | (rule 10 | (enabled_if (<> %{read:config/support_proto3_optional.conf} "")) 11 | (action (copy proto3_optional_test_opt.ml proto3_optional_test.ml))) 12 | 13 | ;; Create an empty test file if proto3 optional fields is not supported by the system's protoc compiler 14 | (rule 15 | (target proto3_optional_test.ml) 16 | (enabled_if (= %{read:config/support_proto3_optional.conf} "")) 17 | (action (with-stdout-to %{target} (echo "")))) 18 | 19 | 20 | ;; exclude proto3_optional_test.ml based on the support 21 | (library 22 | (name test) 23 | (enabled_if (and (<> %{architecture} x86_32) (<> %{architecture} arm32))) 24 | (libraries ocaml_protoc_plugin google_types) 25 | (inline_tests) 26 | (modules :standard \ proto3_optional_test_opt) 27 | (preprocess 28 | (pps ppx_expect ppx_deriving.show ppx_deriving.eq))) 29 | 30 | 31 | (rule 32 | (target google_include) 33 | (action (with-stdout-to %{target} 34 | (system "pkg-config protobuf --variable=includedir")))) 35 | 36 | (rule 37 | (targets 38 | basic.ml primitive_types.ml int_types.ml repeated.ml enum.ml 39 | message.ml oneof.ml map.ml package.ml include.ml included.ml large.ml 40 | included2.ml included3_dash.ml service.ml recursive.ml protocol.ml name_clash.ml 41 | name_clash_mangle.ml proto2.ml packed.ml mangle_names.ml extensions.ml 42 | options.ml name_clash2.ml empty.ml service_rpc_clash.ml service_empty_package.ml) 43 | (deps 44 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 45 | (:proto 46 | basic.proto primitive_types.proto int_types.proto repeated.proto 47 | enum.proto message.proto oneof.proto map.proto package.proto large.proto 48 | include.proto included.proto included2.proto included3-dash.proto service.proto 49 | recursive.proto protocol.proto name_clash.proto name_clash_mangle.proto 50 | proto2.proto packed.proto mangle_names.proto extensions.proto options.proto 51 | name_clash2.proto empty.proto service_rpc_clash.proto service_empty_package.proto) 52 | ) 53 | (action 54 | (run protoc -I %{read-lines:google_include} -I . 55 | "--plugin=protoc-gen-ocaml=%{plugin}" 56 | "--ocaml_out=open=Google_types;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 57 | 58 | (rule 59 | (targets int_types_native.ml int_types_native_proto2.ml) 60 | (deps 61 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 62 | (:proto int_types_native.proto int_types_native_proto2.proto)) 63 | (action 64 | (run protoc -I %{read-lines:google_include} -I . 65 | "--plugin=protoc-gen-ocaml=%{plugin}" 66 | "--ocaml_out=open=Google_types;int32_as_int=false;int64_as_int=false;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 67 | 68 | (rule 69 | (targets singleton_record.ml oneof2.ml) 70 | (deps 71 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 72 | (:proto singleton_record.proto oneof2.proto)) 73 | (action 74 | (run protoc -I %{read-lines:google_include} -I . 75 | "--plugin=protoc-gen-ocaml=%{plugin}" 76 | "--ocaml_out=open=Google_types;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 77 | 78 | (rule 79 | (enabled_if (<> %{read:config/support_proto3_optional.conf} "")) 80 | (target proto3_optional.ml) 81 | (deps 82 | (:plugin ../src/plugin/protoc_gen_ocaml.exe) 83 | (:proto proto3_optional.proto) 84 | ) 85 | (action 86 | (run protoc -I %{read-lines:google_include} -I . 87 | "--experimental_allow_proto3_optional" 88 | "--plugin=protoc-gen-ocaml=%{plugin}" 89 | "--ocaml_out=open=Google_types;annot=[@@deriving show { with_path = false }, eq]:." %{proto}))) 90 | -------------------------------------------------------------------------------- /test/empty.proto: -------------------------------------------------------------------------------- 1 | // Test that code for an empty protofile will compile 2 | syntax = "proto3"; 3 | -------------------------------------------------------------------------------- /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 | let%expect_test _ = 3 | let module T = Enum.Message in 4 | let t = Enum.Message.E.B in 5 | Test_lib.test_encode (module T) t; 6 | [%expect {| enum: B |}] 7 | 8 | let%expect_test _ = 9 | let module T = Enum.Outside in 10 | let t = Enum.E1.C in 11 | Test_lib.test_encode (module T) t; 12 | [%expect {| enum: C |}] 13 | 14 | let%expect_test _ = 15 | let module T = Enum.Aliasing in 16 | let t = T.Enum.Z in 17 | Test_lib.test_encode (module T) t; 18 | (* We do expect the enum to be deserialized as Y. *) 19 | [%expect {| 20 | e: Y 21 | 22 | Expect :Z 23 | Observed:Y |}] 24 | 25 | let%expect_test _ = 26 | let module T = Enum.Negative in 27 | let t = T.Enum.A3 in 28 | Test_lib.test_encode (module T) t; 29 | [%expect {| e: A3 |}] 30 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test/extensions_test.ml: -------------------------------------------------------------------------------- 1 | open Extensions 2 | 3 | let%expect_test _ = 4 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 5 | let foo = Extensions.Baz'.set foo (Some 7) in 6 | let baz = Extensions.Baz'.get foo in 7 | print_endline ([%show: Extensions.Baz.t Ocaml_protoc_plugin.Result.t] baz); 8 | let () = match baz = Ok (Some 7) with 9 | | false -> print_endline "Failed. Not equal" 10 | | true -> () 11 | in 12 | (); 13 | [%expect {| Ok (Some 7) |}] 14 | 15 | let%expect_test _ = 16 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 17 | let foo = Extensions.Baz'.set foo (Some 8) in 18 | let foo = Extensions.Baz'.set foo (Some 7) in 19 | let baz = Extensions.Baz'.get foo in 20 | print_endline ([%show: Extensions.Foo.t] foo); 21 | print_endline ([%show: Extensions.Baz.t Ocaml_protoc_plugin.Result.t] baz); 22 | let () = match baz = Ok (Some 7) with 23 | | false -> print_endline "Failed. Not equal" 24 | | true -> () 25 | in 26 | (); 27 | [%expect {| 28 | { extensions' = (128, (Field.Varint 7L)); bar = (Some 5) } 29 | Ok (Some 7) |}] 30 | 31 | let%expect_test _ = 32 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 33 | let foo = Extensions.Baz'.set foo (Some 8) in 34 | let foo = Extensions.Baz'.set foo (Some 0) in 35 | let foo = Extensions.B2.set foo ([6;7;8]) in 36 | let foo = Extensions.B2.set foo ([]) in 37 | print_endline ([%show: Extensions.Foo.t] foo); 38 | (); 39 | [%expect {| 40 | { extensions' = (128, (Field.Varint 0L)); bar = (Some 5) } |}] 41 | 42 | let%expect_test _ = 43 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 44 | let foo = Extensions.Baz'.set foo (Some 7) in 45 | let foo' = 46 | Extensions.Foo.to_proto foo 47 | |> Ocaml_protoc_plugin.Writer.contents 48 | |> Ocaml_protoc_plugin.Reader.create 49 | |> Extensions.Foo.from_proto 50 | |> Ocaml_protoc_plugin.Result.get ~msg:"Failed decoding" 51 | in 52 | let baz = Extensions.Baz'.get foo' in 53 | print_endline ([%show: Extensions.Baz.t Ocaml_protoc_plugin.Result.t] baz); 54 | let () = match baz = Ok (Some 7) with 55 | | false -> print_endline "Failed. Not equal" 56 | | true -> () 57 | in 58 | (); 59 | [%expect {| Ok (Some 7) |}] 60 | 61 | let%expect_test _ = 62 | let v = [6;7;8;9] in 63 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 64 | let foo = Extensions.R_baz.set foo v in 65 | let foo' = 66 | Extensions.Foo.to_proto foo 67 | |> Ocaml_protoc_plugin.Writer.contents 68 | |> Ocaml_protoc_plugin.Reader.create 69 | |> Extensions.Foo.from_proto 70 | |> Ocaml_protoc_plugin.Result.get ~msg:"Failed decoding" 71 | in 72 | let r_baz = Extensions.R_baz.get foo' in 73 | print_endline ([%show: Extensions.R_baz.t Ocaml_protoc_plugin.Result.t] r_baz); 74 | let () = match r_baz = Ok v with 75 | | false -> print_endline "Failed. Not equal" 76 | | true -> () 77 | in 78 | (); 79 | [%expect {| Ok [6; 7; 8; 9] |}] 80 | 81 | let%expect_test _ = 82 | let foo = Extensions.Foo.{ bar = Some 5; extensions' = Ocaml_protoc_plugin.Extensions.default } in 83 | print_endline ([%show: Extensions.Foo.t] foo); 84 | 85 | let foo = Extensions.A.set foo (Some 7) in 86 | Printf.printf "Set A = Some 7\n"; 87 | print_endline ([%show: Extensions.Foo.t] foo); 88 | 89 | let foo = Extensions.A.set foo None in 90 | Printf.printf "Set A = None\n"; 91 | print_endline ([%show: Extensions.Foo.t] foo); 92 | 93 | let foo = Extensions.B.set foo 15 in 94 | Printf.printf "Set B = 15: %d\n" (Extensions.B.get foo |> Ocaml_protoc_plugin.Result.get ~msg:"No Value"); 95 | print_endline ([%show: Extensions.Foo.t] foo); 96 | 97 | let foo = Extensions.B.set foo 13 in 98 | Printf.printf "Set B = 13: %d\n" (Extensions.B.get foo |> Ocaml_protoc_plugin.Result.get ~msg:"No Value"); 99 | print_endline ([%show: Extensions.Foo.t] foo); 100 | 101 | let foo = Extensions.B.set foo 0 in 102 | Printf.printf "Set B = 0: %d\n" (Extensions.B.get foo |> Ocaml_protoc_plugin.Result.get ~msg:"No Value"); 103 | print_endline ([%show: Extensions.Foo.t] foo); 104 | (); 105 | [%expect {| 106 | { extensions' = ; bar = (Some 5) } 107 | Set A = Some 7 108 | { extensions' = (131, (Field.Varint 7L)); bar = (Some 5) } 109 | Set A = None 110 | { extensions' = ; bar = (Some 5) } 111 | Set B = 15: 15 112 | { extensions' = (132, (Field.Varint 15L)); bar = (Some 5) } 113 | Set B = 13: 13 114 | { extensions' = ; bar = (Some 5) } 115 | Set B = 0: 0 116 | { extensions' = (132, (Field.Varint 0L)); bar = (Some 5) } |}] 117 | -------------------------------------------------------------------------------- /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 | let%expect_test _ = 4 | let module T = Include.I in 5 | let t = T.{ enum = Enum.Message.E.B; 6 | m = Some 3; 7 | o = Some Enum.E1.C; 8 | c = Some 7; 9 | } in 10 | Test_lib.test_encode (module T) t; 11 | [%expect {| 12 | enum: B 13 | m { 14 | i: 3 15 | } 16 | o { 17 | enum: C 18 | } 19 | c { 20 | i: 7 21 | } |}] 22 | 23 | 24 | let%expect_test _ = 25 | let module T = Include.Z in 26 | let t = Some Included.Include.N.E.B in 27 | Test_lib.test_encode (module T) t; 28 | [%expect {| 29 | n { 30 | e: B 31 | } |}] 32 | 33 | let%expect_test _ = 34 | let module T = Include.Y in 35 | let t = Some 42 in 36 | Test_lib.test_encode (module T) t; 37 | [%expect {| 38 | d { 39 | i: 42 40 | } |}] 41 | -------------------------------------------------------------------------------- /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 test_signed64 (type t) ~(create : Int64.t -> t) (module T : Test_lib.T with type t = t) = 5 | Printf.printf "Test %s\n%!" (T.name' ()); 6 | let values = [-1073741823L; -2L; -1L; 0L; 1L; 2L; 1073741823L] in 7 | List.iter 8 | ~f:(fun v -> Test_lib.test_encode (module T) (create v)) 9 | values 10 | 11 | let test_unsigned64 (type t) ~(create : Int64.t -> t) (module T : Test_lib.T with type t = t) = 12 | Printf.printf "Test %s\n%!" (T.name' ()); 13 | let values = [0L; 1L; 2L; 2147483647L] in 14 | List.iter 15 | ~f:(fun v -> Test_lib.test_encode (module T) (create v)) 16 | values 17 | 18 | let test_signed32 (type t) ~(create : Int32.t -> t) (module T : Test_lib.T with type t = t) = 19 | Printf.printf "Test %s\n%!" (T.name' ()); 20 | let values = [-1073741823l; -2l; -1l; 0l; 1l; 2l; 1073741823l] in 21 | List.iter 22 | ~f:(fun v -> Test_lib.test_encode (module T) (create v)) 23 | values 24 | 25 | let test_unsigned32 (type t) ~(create : Int32.t -> t) (module T : Test_lib.T with type t = t) = 26 | Printf.printf "Test %s\n%!" (T.name' ()); 27 | let values = [0l; 1l; 2l; 2147483647l] in 28 | List.iter 29 | ~f:(fun v -> Test_lib.test_encode (module T) (create v)) 30 | values 31 | 32 | let%expect_test _ = 33 | let module T = Int_types_native.SInt64 in 34 | let create i = i in 35 | test_signed64 ~create (module T); 36 | [%expect {| 37 | Test int_types_native.int_types_native.SInt64 38 | i: -1073741823 39 | i: -2 40 | i: -1 41 | i: 1 42 | i: 2 43 | i: 1073741823 |}] 44 | 45 | let%expect_test _ = 46 | let module T = Int_types_native.SInt32 in 47 | let create i = i in 48 | test_signed32 ~create (module T); 49 | [%expect {| 50 | Test int_types_native.int_types_native.SInt32 51 | i: -1073741823 52 | i: -2 53 | i: -1 54 | i: 1 55 | i: 2 56 | i: 1073741823 |}] 57 | 58 | let%expect_test _ = 59 | let module T = Int_types_native.Int64 in 60 | let create i = i in 61 | test_signed64 ~create (module T); 62 | [%expect {| 63 | Test int_types_native.int_types_native.Int64 64 | i: -1073741823 65 | i: -2 66 | i: -1 67 | i: 1 68 | i: 2 69 | i: 1073741823 |}] 70 | 71 | let%expect_test _ = 72 | let module T = Int_types_native.Int32 in 73 | let create i = i in 74 | test_signed32 ~create (module T); 75 | [%expect 76 | {| 77 | Test int_types_native.int_types_native.Int32 78 | i: -1073741823 79 | i: -2 80 | i: -1 81 | i: 1 82 | i: 2 83 | i: 1073741823 |}] 84 | 85 | let%expect_test _ = 86 | let module T = Int_types_native.UInt64 in 87 | let create i = i in 88 | test_unsigned64 ~create (module T); 89 | [%expect {| 90 | Test int_types_native.int_types_native.UInt64 91 | i: 1 92 | i: 2 93 | i: 2147483647 |}] 94 | 95 | let%expect_test _ = 96 | let module T = Int_types_native.UInt32 in 97 | let create i = i in 98 | test_unsigned32 ~create (module T); 99 | [%expect {| 100 | Test int_types_native.int_types_native.UInt32 101 | i: 1 102 | i: 2 103 | i: 2147483647 |}] 104 | -------------------------------------------------------------------------------- /test/int_types_test.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | open Int_types 3 | 4 | let test_signed (type t) ~(create : int -> t) (module T : Test_lib.T with type t = t) = 5 | Printf.printf "Test %s\n%!" (T.name' ()); 6 | let values = [-1073741823; -2; -1; 0; 1; 2; 1073741823] in 7 | List.iter 8 | ~f:(fun v -> Test_lib.test_encode (module T) (create v)) 9 | values 10 | 11 | let test_unsigned (type t) ~(create : int -> t) (module T : Test_lib.T with type t = t) = 12 | Printf.printf "Test %s\n%!" (T.name' ()); 13 | let values = [0; 1; 2; 2147483647; 4294967295] in 14 | List.iter 15 | ~f:(fun v -> Test_lib.test_encode (module T) (create v)) 16 | values 17 | 18 | let%expect_test _ = 19 | let module T = Int_types.SInt64 in 20 | let create i = i in 21 | test_signed ~create (module T); 22 | [%expect {| 23 | Test int_types.int_types.SInt64 24 | i: -1073741823 25 | i: -2 26 | i: -1 27 | i: 1 28 | i: 2 29 | i: 1073741823 |}] 30 | 31 | let%expect_test _ = 32 | let module T = Int_types.SInt32 in 33 | let create i = i in 34 | test_signed ~create (module T); 35 | [%expect {| 36 | Test int_types.int_types.SInt32 37 | i: -1073741823 38 | i: -2 39 | i: -1 40 | i: 1 41 | i: 2 42 | i: 1073741823 |}] 43 | 44 | let%expect_test _ = 45 | let module T = Int_types.Int64 in 46 | let create i = i in 47 | test_signed ~create (module T); 48 | [%expect {| 49 | Test int_types.int_types.Int64 50 | i: -1073741823 51 | i: -2 52 | i: -1 53 | i: 1 54 | i: 2 55 | i: 1073741823 |}] 56 | 57 | let%expect_test _ = 58 | let module T = Int_types.Int32 in 59 | let create i = i in 60 | test_signed ~create (module T); 61 | [%expect 62 | {| 63 | Test int_types.int_types.Int32 64 | i: -1073741823 65 | i: -2 66 | i: -1 67 | i: 1 68 | i: 2 69 | i: 1073741823 |}] 70 | 71 | let%expect_test _ = 72 | let module T = Int_types.UInt64 in 73 | let create i = i in 74 | test_unsigned ~create (module T); 75 | [%expect {| 76 | Test int_types.int_types.UInt64 77 | i: 1 78 | i: 2 79 | i: 2147483647 80 | i: 4294967295 |}] 81 | 82 | let%expect_test _ = 83 | let module T = Int_types.UInt32 in 84 | let create i = i in 85 | test_unsigned ~create (module T); 86 | [%expect {| 87 | Test int_types.int_types.UInt32 88 | i: 1 89 | i: 2 90 | i: 2147483647 91 | i: 4294967295 |}] 92 | -------------------------------------------------------------------------------- /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 | open Ocaml_protoc_plugin 3 | 4 | let%expect_test "Test very large message type" = 5 | let large = Large.make ~x7:7 () in 6 | let writer = Large.to_proto large in 7 | let contents = Writer.contents writer in 8 | Printf.printf "Size of large message: %d\n" (String.length contents); 9 | let reader = Reader.create contents in 10 | let large' = Large.from_proto_exn reader in 11 | Printf.printf "Serialization works: %b\n" (large = large'); 12 | Printf.printf "x7: %d = %d\n" large.x7 large'.x7; 13 | Printf.printf "x5: %d = %d\n" large.x5 large'.x5; 14 | (); 15 | [%expect {| 16 | Size of large message: 2 17 | Serialization works: true 18 | x7: 7 = 7 19 | x5: 0 = 0 |}] 20 | -------------------------------------------------------------------------------- /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 Two { 10 | map m = 1; 11 | map n = 20; 12 | } 13 | 14 | message Map_message { 15 | message Inner { 16 | int64 i = 1; 17 | } 18 | map m = 1; 19 | } 20 | 21 | message Map_message2 { 22 | map m = 1; 23 | } 24 | 25 | message Map_message3 { 26 | enum Enum { 27 | A = 0; 28 | B = 1; 29 | }; 30 | map m = 1; 31 | } 32 | -------------------------------------------------------------------------------- /test/map_test.ml: -------------------------------------------------------------------------------- 1 | open Map 2 | let%expect_test _ = 3 | let module T = Map.Test in 4 | let t = [ 1, "1"; 2, "2"; 3, "3" ] in 5 | Test_lib.test_encode (module T) t; 6 | [%expect {| 7 | m { 8 | key: 1 9 | value: "1" 10 | } 11 | m { 12 | key: 2 13 | value: "2" 14 | } 15 | m { 16 | key: 3 17 | value: "3" 18 | } |}] 19 | 20 | 21 | let%expect_test _ = 22 | let module T = Map.Two in 23 | let t = T.{ m = [ 1, "1"; 2, "2"; 3, "3" ]; 24 | n = [ 1, 1.0; 2, 2.0; 3, 3.0 ]} in 25 | Test_lib.test_encode (module T) t; 26 | [%expect {| 27 | m { 28 | key: 1 29 | value: "1" 30 | } 31 | m { 32 | key: 2 33 | value: "2" 34 | } 35 | m { 36 | key: 3 37 | value: "3" 38 | } 39 | n { 40 | key: 1 41 | value: 1 42 | } 43 | n { 44 | key: 2 45 | value: 2 46 | } 47 | n { 48 | key: 3 49 | value: 3 50 | } |}] 51 | 52 | 53 | let%expect_test _ = 54 | let module T = Map.Map_message in 55 | let t = [ 1, Some 1; 56 | 2, Some 1; 57 | 3, Some 1; 58 | 4, Some 1; ] 59 | in 60 | Test_lib.test_encode (module T) t; 61 | [%expect {| 62 | m { 63 | key: 1 64 | value { 65 | i: 1 66 | } 67 | } 68 | m { 69 | key: 2 70 | value { 71 | i: 1 72 | } 73 | } 74 | m { 75 | key: 3 76 | value { 77 | i: 1 78 | } 79 | } 80 | m { 81 | key: 4 82 | value { 83 | i: 1 84 | } 85 | } |}] 86 | -------------------------------------------------------------------------------- /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 | let%expect_test _ = 3 | let module T = Message.Message in 4 | let submessage = 3 in 5 | let validate = T.make ~m:submessage () in 6 | let t = Some submessage in 7 | Test_lib.test_encode (module T) ~validate t; 8 | [%expect {| 9 | m { 10 | i: 3 11 | } |}] 12 | 13 | (** The message containing a submessage with all default values. 14 | The length of the submessage is 0, so 15 | the message will be index 1, with length delimited type (2): 16 | 1 * 8 + 2 = 0xa 17 | The length of the delimited type is 0, so the complete message shoud be: 18 | 0xa 0x0. 19 | *) 20 | 21 | let%expect_test _ = 22 | let module T = Message.Message in 23 | let validate = T.make ~m:0 () in 24 | let t = Some 0 in 25 | Test_lib.test_encode (module T) ~validate t; 26 | [%expect {| 27 | m { 28 | } |}] 29 | 30 | let%expect_test _ = 31 | let module T = Message.Message in 32 | let validate = T.make ~m:1 () in 33 | let t = Some 1 in 34 | Test_lib.test_encode (module T) ~validate t; 35 | [%expect {| 36 | m { 37 | i: 1 38 | } |}] 39 | 40 | let%expect_test _ = 41 | let module T = Message.Message in 42 | let validate = T.make () in 43 | let t = None in 44 | Test_lib.test_encode (module T) ~validate t; 45 | [%expect {| |}] 46 | 47 | let%expect_test _ = 48 | let module T = Message.Message2 in 49 | let validate = T.make ~i:2 () in 50 | let t = T.{i = 2; m = None} in 51 | Test_lib.test_encode (module T) ~validate t; 52 | [%expect {| 53 | i: 2 |}] 54 | 55 | let%expect_test _ = 56 | let module T = Message.Message2 in 57 | let submessage = 0 in 58 | let validate = T.make ~i:2 ~m:submessage () in 59 | let t = T.{i = 2; m = Some submessage} in 60 | Test_lib.test_encode (module T) ~validate t; 61 | [%expect {| 62 | i: 2 63 | m { 64 | } |}] 65 | -------------------------------------------------------------------------------- /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 { int64 f = 30; }; 62 | } 63 | -------------------------------------------------------------------------------- /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 | let%expect_test _ = 3 | let module T = Oneof.Test in 4 | let t = T.{ y = 5; x = `I 7} in 5 | Test_lib.test_encode ~dump:true (module T) t; 6 | [%expect {| 7 | Buffer: '08-05-50-07' 8 | y: 5 9 | i: 7 |}] 10 | 11 | let%expect_test _ = 12 | let module T = Oneof.Test2 in 13 | let t = `F3 "test" in 14 | Test_lib.test_encode (module T) t; 15 | [%expect {| 16 | f3: "test" |}] 17 | 18 | let%expect_test "Multiple oneofs" = 19 | let module T = Oneof.Test3 in 20 | let t = T.{ x = `X1 3; y = `Y2 5; z = `Z1 7 } in 21 | Test_lib.test_encode (module T) t; 22 | [%expect {| 23 | x1: 3 24 | y2: 5 25 | z1: 7 |}] 26 | 27 | let%expect_test "Default values in oneof" = 28 | let module T = Oneof.Test3 in 29 | let t = T.{ x = `X1 0; y = `Y2 0; z = `Z2 0 } in 30 | Test_lib.test_encode (module T) t; 31 | [%expect {| 32 | x1: 0 33 | y2: 0 34 | z2: 0 |}] 35 | 36 | let%expect_test "Single field oneof" = 37 | let module T = Oneof.Test4 in 38 | let t = `I 5 in 39 | Test_lib.test_encode (module T) t; 40 | [%expect {| 41 | i: 5 |}] 42 | 43 | let%expect_test "Single field oneof" = 44 | let module T = Oneof.Test5 in 45 | let t = `E () in 46 | Test_lib.test_encode (module T) t; 47 | [%expect {| 48 | e { 49 | } |}] 50 | -------------------------------------------------------------------------------- /test/oneof_test.ml: -------------------------------------------------------------------------------- 1 | open Oneof 2 | let%expect_test _ = 3 | let module T = Oneof.Test in 4 | let t = T.{ y = 5; x = `I 7} in 5 | Test_lib.test_encode ~dump:true (module T) t; 6 | [%expect {| 7 | Buffer: '08-05-50-07' 8 | y: 5 9 | i: 7 |}] 10 | 11 | let%expect_test _ = 12 | let module T = Oneof.Test2 in 13 | let t = `F3 "test" in 14 | Test_lib.test_encode (module T) t; 15 | [%expect {| 16 | f3: "test" |}] 17 | 18 | let%expect_test "Multiple oneofs" = 19 | let module T = Oneof.Test3 in 20 | let t = T.{ x = `X1 3; y = `Y2 5; z = `Z1 7 } in 21 | Test_lib.test_encode (module T) t; 22 | [%expect {| 23 | x1: 3 24 | y2: 5 25 | z1: 7 |}] 26 | 27 | let%expect_test "Default values in oneof" = 28 | let module T = Oneof.Test3 in 29 | let t = T.{ x = `X1 0; y = `Y2 0; z = `Z2 0 } in 30 | Test_lib.test_encode (module T) t; 31 | [%expect {| 32 | x1: 0 33 | y2: 0 34 | z2: 0 |}] 35 | 36 | let%expect_test "Single field oneof" = 37 | let module T = Oneof.Test4 in 38 | let t = `I 5 in 39 | Test_lib.test_encode (module T) t; 40 | [%expect {| 41 | i: 5 |}] 42 | 43 | let%expect_test "Single field oneof" = 44 | let module T = Oneof.Test5 in 45 | let t = `E () in 46 | Test_lib.test_encode (module T) t; 47 | [%expect {| 48 | e { 49 | } |}] 50 | -------------------------------------------------------------------------------- /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%expect_test _ = 3 | let module T = Package.A.B.M in 4 | let t = 7 in 5 | Test_lib.test_encode (module T) t; 6 | [%expect {| 7 | i: 7 |}] 8 | -------------------------------------------------------------------------------- /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 | let%expect_test "Packed" = 3 | let module T = Packed.Packed in 4 | let module T' = Packed.String in 5 | let t = [5; 6; 0; 7; 8; 9] in 6 | Test_lib.test_encode (module T) t; 7 | let contents = 8 | T.to_proto t 9 | |> Ocaml_protoc_plugin.Writer.contents 10 | in 11 | contents 12 | |> Ocaml_protoc_plugin.Reader.create 13 | |> T'.from_proto 14 | |> (function 15 | | Ok t -> Printf.printf "Data: %s. Size: %d\n" (T'.show t) (String.length contents) 16 | | Error e -> Printf.printf "Failed to decode: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 17 | ); 18 | [%expect {| 19 | i: 5 20 | i: 6 21 | i: 0 22 | i: 7 23 | i: 8 24 | i: 9 25 | Data: "\005\006\000\007\b\t". Size: 8 |}] 26 | 27 | let%expect_test "Not packed" = 28 | let module T = Packed.Not_packed in 29 | let module T' = Packed.UInt in 30 | let t = [5; 6; 0; 7; 8; 9] in 31 | Test_lib.test_encode (module T) t; 32 | let contents = 33 | T.to_proto t 34 | |> Ocaml_protoc_plugin.Writer.contents 35 | in 36 | contents 37 | |> Ocaml_protoc_plugin.Reader.create 38 | |> T'.from_proto 39 | |> (function 40 | | Ok t -> Printf.printf "Last element: %s. Size: %d\n" (T'.show t) (String.length contents) 41 | 42 | | Error e -> Printf.printf "Failed to decode: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 43 | ); 44 | [%expect {| 45 | i: 5 46 | i: 6 47 | i: 0 48 | i: 7 49 | i: 8 50 | i: 9 51 | Last element: 9. Size: 12 |}] 52 | 53 | (* Verify that empty lists are not serialized at all *) 54 | let%expect_test "Empty lists are not transmitted" = 55 | Test_lib.test_encode (module Packed.Packed) []; 56 | Packed.Packed.to_proto [] 57 | |> Ocaml_protoc_plugin.Writer.contents 58 | |> String.length 59 | |> Printf.eprintf "Size packed %d\n"; 60 | 61 | Test_lib.test_encode (module Packed.Not_packed) []; 62 | Packed.Not_packed.to_proto [] 63 | |> Ocaml_protoc_plugin.Writer.contents 64 | |> String.length 65 | |> Printf.eprintf "Size packed %d\n"; 66 | (); 67 | [%expect {| 68 | Size packed 0 69 | Size packed 0 |}] 70 | -------------------------------------------------------------------------------- /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%expect_test _ = 3 | let module T = Primitive_types.Types in 4 | let t = 5 | T. 6 | { 7 | int64 = 1; 8 | sint64 = 2; 9 | uint64 = 3; 10 | int32 = 4; 11 | sint32 = 5; 12 | uint32 = 6; 13 | double = 7.1; 14 | float = 8.0; 15 | fixed64 = 9L; 16 | fixed32 = 10l; 17 | sfixed64 = 11L; 18 | sfixed32 = 12l; 19 | bool = true; 20 | string = "string"; 21 | bytes = Bytes.of_string "bytes"; 22 | } 23 | in 24 | Test_lib.test_encode (module T) t; 25 | [%expect 26 | {| 27 | int64: 1 28 | sint64: 2 29 | uint64: 3 30 | int32: 4 31 | sint32: 5 32 | uint32: 6 33 | double: 7.1 34 | float: 8 35 | fixed64: 9 36 | fixed32: 10 37 | sfixed64: 11 38 | sfixed32: 12 39 | bool: true 40 | string: "string" 41 | bytes: "bytes" |}] 42 | 43 | let%expect_test _ = 44 | let module T = Primitive_types.Types in 45 | let t = 46 | T. 47 | { 48 | int64 = 0; 49 | sint64 = 0; 50 | uint64 = 0; 51 | int32 = 0; 52 | sint32 = 0; 53 | uint32 = 0; 54 | double = 0.0; 55 | float = 0.0; 56 | fixed64 = 0L; 57 | fixed32 = 0l; 58 | sfixed64 = 0L; 59 | sfixed32 = 0l; 60 | bool = false; 61 | string = ""; 62 | bytes = Bytes.of_string ""; 63 | } 64 | in 65 | let bin = T.to_proto t in 66 | Printf.printf "Size: %d%!" (Ocaml_protoc_plugin.Writer.contents bin |> String.length); 67 | [%expect {| Size: 0 |}] 68 | 69 | 70 | let%expect_test _ = 71 | let module T = Primitive_types.Empty in 72 | let t = () in 73 | Test_lib.test_encode (module T) t; 74 | [%expect {| |}] 75 | -------------------------------------------------------------------------------- /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 | } 13 | enum E { 14 | A = 0; 15 | B = 1; 16 | C = 2; 17 | } 18 | optional E enum = 1; 19 | optional uint64 i = 2 [default = 4]; 20 | required uint64 j = 3 [default = 4]; // Setting default on a required field really does not make sense 21 | optional uint64 k = 5; 22 | required Required required = 4; 23 | } 24 | 25 | message Message1 { 26 | enum E { A = 0; B = 1; C = 2; }; 27 | optional int32 opt = 1; 28 | required int32 req = 2; 29 | optional string s = 3 [default = "default string"]; 30 | optional uint32 u = 4 [default = 27]; 31 | optional bytes b = 5 [default = "default bytes"]; 32 | optional uint64 c = 6 [default = 27]; 33 | optional float f = 7 [default = 27]; 34 | optional E e = 8 [default = B]; 35 | } 36 | 37 | message Message1_ { 38 | required int32 req = 2; 39 | } 40 | 41 | message MessageEnumDefault { 42 | optional Message.E e = 8 [default = B]; 43 | } 44 | 45 | message Map_message2 { 46 | map m = 1; 47 | } 48 | 49 | message Map_message3 { 50 | enum Enum { 51 | A = 0; 52 | B = 1; 53 | }; 54 | map m = 1; 55 | } 56 | 57 | message MessageDefaults { 58 | optional string o0 = 10 [default = "default string"]; 59 | optional bytes o1 = 11 [default = "default bytes"]; 60 | optional uint32 o2 = 12 [default = 27]; 61 | optional uint64 o3 = 13 [default = 27]; 62 | optional int32 o4 = 14 [default = -27]; 63 | optional int64 o5 = 15 [default = -27]; 64 | optional sint32 o6 = 16 [default = -27]; 65 | optional sint64 o7 = 17 [default = -27]; 66 | optional fixed32 o8 = 18 [default = 27]; 67 | optional fixed64 o9 = 19 [default = 27]; 68 | optional sfixed32 oa = 20 [default = -27]; 69 | optional sfixed64 ob = 21 [default = -27]; 70 | optional float oc = 22 [default = -27]; 71 | optional double od = 23 [default = -27]; 72 | optional bool oe = 24 [default = true]; 73 | } 74 | -------------------------------------------------------------------------------- /test/proto2_test.ml: -------------------------------------------------------------------------------- 1 | open Proto2 2 | let%expect_test _ = 3 | let module T = Proto2.Message in 4 | let t = T.{enum = Some E.B; i = 0; j = 5; required = Some 7; k = Some 5 } in 5 | Test_lib.test_encode (module T) t; 6 | [%expect {| 7 | enum: B 8 | i: 0 9 | j: 5 10 | required { 11 | a: 7 12 | } 13 | k: 5 |}] 14 | 15 | let%expect_test "Default read default values" = 16 | let module T = Proto2.A in 17 | let () = match T.from_proto (Ocaml_protoc_plugin.Reader.create "") with 18 | | Ok t -> print_endline (T.show t) 19 | | Error e -> Printf.printf "Decode failure: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 20 | in (); 21 | [%expect {| 4 |}] 22 | 23 | let%expect_test "Required fields must be in the message" = 24 | let module T = Proto2.Message1 in 25 | let () = match T.from_proto (Ocaml_protoc_plugin.Reader.create "") with 26 | | Ok t -> print_endline (T.show t) 27 | | Error e -> Printf.printf "Decode failure: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 28 | in (); 29 | [%expect {| Decode failure: `Required_field_missing |}] 30 | 31 | let%expect_test "Only tramitting the required field" = 32 | let module T = Proto2.Message1_ in 33 | let writer = T.to_proto 0 in 34 | let module T = Proto2.Message1 in 35 | let () = match T.from_proto (Ocaml_protoc_plugin.Writer.contents writer |> Ocaml_protoc_plugin.Reader.create) with 36 | | Ok t -> print_endline (T.show t) 37 | | Error e -> Printf.printf "Decode failure: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 38 | in (); 39 | [%expect {| 40 | { opt = None; req = 0; s = "default string"; u = 27; b = "default bytes"; 41 | c = 27; f = 27.; e = B } |}] 42 | 43 | let%expect_test "Default created messages should not set any fields" = 44 | let module T = Proto2.MessageDefaults in 45 | let t = T.make () in 46 | let message = T.to_proto t in 47 | Printf.printf "Size of message: %d\n" (String.length (Ocaml_protoc_plugin.Writer.contents message)); 48 | let () = match T.from_proto (Ocaml_protoc_plugin.Reader.create "") with 49 | | Ok t -> print_endline (T.show t) 50 | | Error e -> Printf.printf "Decode failure: %s\n" (Ocaml_protoc_plugin.Result.show_error e) 51 | in (); 52 | [%expect {| 53 | Size of message: 0 54 | { o0 = "default string"; o1 = "default bytes"; o2 = 27; o3 = 27; o4 = -27; 55 | o5 = -27; o6 = -27; o7 = -27; o8 = 27l; o9 = 27L; oa = -27l; ob = -27L; 56 | oc = -27.; od = -27.; oe = true } |}] 57 | -------------------------------------------------------------------------------- /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%expect_test _ = 4 | let module T = Proto3_optional.Message in 5 | let t = T.make ~payload:5 () in 6 | Test_lib.test_encode ~protoc_args:["--experimental_allow_proto3_optional"] (module T) t; 7 | [%expect {| payload: 5 |}] 8 | 9 | let%expect_test _ = 10 | let module T = Proto3_optional.Message2 in 11 | let t = T.make ~payload:5 ~payload3:7 () in 12 | Test_lib.test_encode ~protoc_args:["--experimental_allow_proto3_optional"] (module T) t; 13 | [%expect {| 14 | payload: 5 15 | payload3: 7 |}] 16 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test/recursive_test.ml: -------------------------------------------------------------------------------- 1 | open Recursive 2 | let%expect_test _ = 3 | let module T = Recursive.Message in 4 | let t = T.{ m = Some T.Message1.{ m1 = Some T.{ m = Some T.Message1.{ m1 = None } } } } in 5 | Test_lib.test_encode (module T) t; 6 | [%expect {| 7 | m { 8 | m1 { 9 | m { 10 | } 11 | } 12 | } |}] 13 | 14 | let%expect_test _ = 15 | let module T1 = Recursive.Mutual1 in 16 | let module T2 = Recursive.Mutual2 in 17 | let t = T1.{ m2 = Some T2.{ m1 = Some T1.{ m2 = Some T2.{ m1 = None }}}} in 18 | Test_lib.test_encode (module T1) t; 19 | [%expect {| 20 | m2 { 21 | m1 { 22 | m2 { 23 | } 24 | } 25 | } |}] 26 | 27 | let%expect_test _ = 28 | let module T = Recursive.StdTree in 29 | 30 | let rec add v = function 31 | | None -> Some T.{ left = None; value = v; right = None} 32 | | Some T.{ left; value; right} when v < value -> 33 | Some T.{ left = add v left; value; right } 34 | | Some T.{ left; value; right} when v > value -> 35 | Some T.{ left = left; value; right = add v right; } 36 | | x -> x 37 | in 38 | let rec elements = function 39 | | None -> 0 40 | | Some T.{left; right; _} -> 1 + elements left + elements right 41 | in 42 | let rec depth = function 43 | | None -> 0 44 | | Some T.{ left; right; _} -> 45 | max (depth left) (depth right) + 1 46 | in 47 | 48 | (* Protoc cannot handle nested structure with a depth > 101. *) 49 | let t = 50 | List.init 10000 (fun i -> i lxor 0x57c) 51 | |> List.fold_left (fun acc i -> add i acc) None 52 | |> fun t -> T.{ left = t; value = 10000; right = None } 53 | in 54 | Printf.printf "Elements: %d\n" (elements (Some t)); 55 | Printf.printf "Depth: %d\n" (depth (Some t)); 56 | 57 | Test_lib.test_encode ~protoc:false (module T) t; 58 | [%expect {| 59 | Elements: 10001 60 | Depth: 200 |}] 61 | -------------------------------------------------------------------------------- /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%expect_test _ = 3 | let module T = Repeated.UInt64 in 4 | let validate = T.make ~i:[5; 6; 7; 8; 9] () in 5 | let t = [5; 6; 7; 8; 9] in 6 | Test_lib.test_encode (module T) ~validate t; 7 | [%expect {| 8 | i: 5 9 | i: 6 10 | i: 7 11 | i: 8 12 | i: 9 |}] 13 | 14 | let%expect_test _ = 15 | let module T = Repeated.Double in 16 | let t = [0.; 1.; 2.; 3.; 4.] in 17 | Test_lib.test_encode (module T) t; 18 | [%expect {| 19 | i: 0 20 | i: 1 21 | i: 2 22 | i: 3 23 | i: 4 |}] 24 | 25 | let%expect_test _ = 26 | let module T = Repeated.Float in 27 | let t = [0.; 1.; 2.; 3.; 4.] in 28 | Test_lib.test_encode (module T) t; 29 | [%expect {| 30 | i: 0 31 | i: 1 32 | i: 2 33 | i: 3 34 | i: 4 |}] 35 | 36 | let%expect_test _ = 37 | let module T = Repeated.String in 38 | let t = ["0"; "1"; "2"; "3"; "4"] in 39 | Test_lib.test_encode (module T) t; 40 | [%expect {| 41 | i: "0" 42 | i: "1" 43 | i: "2" 44 | i: "3" 45 | i: "4" |}] 46 | 47 | let%expect_test _ = 48 | let module T = Repeated.Enum in 49 | let t = T.E.[A; B; C; A; C] in 50 | Test_lib.test_encode (module T) t; 51 | [%expect {| 52 | e: A 53 | e: B 54 | e: C 55 | e: A 56 | e: C |}] 57 | 58 | let%expect_test _ = 59 | let module T = Repeated.Message in 60 | let m i = i in 61 | let t = [m 0; m 1; m 2; m 1; m 0; m 5] in 62 | Test_lib.test_encode (module T) t; 63 | [%expect 64 | {| 65 | ms { 66 | } 67 | ms { 68 | i: 1 69 | } 70 | ms { 71 | i: 2 72 | } 73 | ms { 74 | i: 1 75 | } 76 | ms { 77 | } 78 | ms { 79 | i: 5 80 | } |}] 81 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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_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%expect_test _ = 4 | let module T = Singleton_record.Test in 5 | let t = `J "Test" in 6 | Test_lib.test_encode (module T) t; 7 | [%expect {| 8 | j: "Test" |}] 9 | 10 | let%expect_test _ = 11 | let module T = Singleton_record.Test2 in 12 | let t = `F3 "Test" in 13 | Test_lib.test_encode (module T) t; 14 | [%expect {| 15 | f3: "Test" |}] 16 | 17 | let%expect_test _ = 18 | let module T = Singleton_record.Test3 in 19 | let t = 7 in 20 | Test_lib.test_encode (module T) t; 21 | [%expect {| 22 | x1: 7 |}] 23 | 24 | let%expect_test _ = 25 | let module T = Singleton_record.Test4 in 26 | let t = Some (`J "test") in 27 | Test_lib.test_encode (module T) t; 28 | [%expect {| 29 | t { 30 | j: "test" 31 | } |}] 32 | 33 | let%expect_test _ = 34 | let module T = Singleton_record.Test5 in 35 | let t = Some T.M.E.B in 36 | Test_lib.test_encode (module T) t; 37 | [%expect {| 38 | m { 39 | enum: B 40 | } |}] 41 | -------------------------------------------------------------------------------- /test/test_lib.ml: -------------------------------------------------------------------------------- 1 | open StdLabels 2 | 3 | module type T = sig 4 | type t [@@deriving show, eq] 5 | val to_proto : t -> Ocaml_protoc_plugin.Writer.t 6 | val from_proto : Ocaml_protoc_plugin.Reader.t -> t Ocaml_protoc_plugin.Result.t 7 | val name' : unit -> string 8 | end 9 | 10 | let hexlify data = 11 | let acc = ref [] in 12 | String.iter ~f:(fun ch -> (acc := Char.code ch :: !acc)) data; 13 | List.rev !acc 14 | |> List.map ~f:(Printf.sprintf "%02x") 15 | |> String.concat ~sep:"-" 16 | |> Printf.printf "Buffer: '%s'\n" 17 | 18 | let dump_protoc ?(protoc_args=[]) name data = 19 | let protobuf_file, type_name = 20 | match String.split_on_char ~sep:'.' name with 21 | | protobuf_name :: type_name -> 22 | Printf.sprintf "%s.proto" (String.uncapitalize_ascii protobuf_name), 23 | String.concat ~sep:"." type_name 24 | | _ -> failwith "Illegal type name" 25 | in 26 | let filename = Filename.temp_file name ".bin" in 27 | let cout = open_out filename in 28 | output_string cout data; 29 | close_out cout; 30 | Printf.printf "%!"; 31 | let res = Sys.command 32 | (Printf.sprintf 33 | "protoc %s --decode=%s %s < %s" 34 | (String.concat ~sep:" " protoc_args) 35 | type_name 36 | protobuf_file 37 | filename) 38 | in 39 | Sys.remove filename; 40 | match res with 41 | | 0 -> () 42 | | n -> Printf.printf "'protoc' exited with status code: %d\n" n 43 | 44 | 45 | (** Create a common function for testing. *) 46 | let test_encode (type t) ?dump ?(protoc=true) ?protoc_args (module M : T with type t = t) ?(validate : t option) (expect : t) = 47 | let () = match validate with 48 | | Some v when v <> expect -> Printf.printf "Validate match failed\n" 49 | | _ -> () 50 | in 51 | let data = M.to_proto expect |> Ocaml_protoc_plugin.Writer.contents in 52 | let () = 53 | match dump with 54 | | Some _ -> hexlify data 55 | | None -> () 56 | in 57 | let () = match protoc with 58 | | true -> dump_protoc ?protoc_args (M.name' ()) data 59 | | false -> () 60 | in 61 | (* Decode the message *) 62 | let in_data = Ocaml_protoc_plugin.Reader.create data in 63 | match M.from_proto in_data with 64 | | Ok observed when M.equal expect observed -> () 65 | | Ok observed -> 66 | Printf.printf "\nExpect :%s\nObserved:%s\n" ([%show: M.t] expect) ([%show: M.t] observed) 67 | | Error err -> 68 | Printf.printf "\nDecode failed: %s \n" (Ocaml_protoc_plugin.Result.show_error err) 69 | --------------------------------------------------------------------------------