├── .gitignore ├── .travis.yml ├── CONTRIBUTING.md ├── LICENSE ├── Makefile ├── README.md ├── Setup.hs ├── cabal.project.travis ├── cbits ├── hs_byte_buffer.c ├── hs_grpc.c └── hs_time.c ├── examples └── route_guide_client.hs ├── grpc.cabal ├── grpc.cabal.template ├── include ├── hs_byte_buffer.h ├── hs_grpc.h └── hs_time.h ├── src └── Network │ └── Grpc │ ├── CompletionQueue.hs │ ├── Core │ └── Call.chs │ └── Lib │ ├── ByteBuffer.chs │ ├── ChannelArgs.hs │ ├── ChannelArgsStrings.hsc │ ├── Core.chs │ ├── Metadata.chs │ ├── PropagationBits.hsc │ ├── TimeSpec.chs │ └── Version.chs └── tests └── interop_client ├── main.hs └── proto └── Proto └── Src └── Proto └── Grpc └── Testing ├── Empty.hs └── Messages.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # See https://github.com/hvr/multi-ghc-travis for more information 2 | 3 | language: c 4 | 5 | dist: trusty 6 | sudo: false 7 | 8 | addons: 9 | apt: 10 | sources: &apt_sources 11 | - hvr-ghc 12 | packages: &apt_packages 13 | - build-essential 14 | - autoconf 15 | - libtool 16 | - libgflags-dev 17 | - libgtest-dev 18 | - libc++-dev 19 | # for c2hs 20 | - alex-3.1.7 21 | - happy-1.19.5 22 | 23 | cache: 24 | directories: 25 | - $HOME/.cabal/lib 26 | - $HOME/.cabal/packages 27 | - $HOME/.cabal/share 28 | - $HOME/.cabal/store 29 | 30 | matrix: 31 | include: 32 | - env: CABALVER=1.24 GHCVER=7.10.3 33 | addons: {apt: {packages: [*apt_packages, cabal-install-1.24, ghc-7.10.3], sources: [*apt_sources]}} 34 | - env: CABALVER=1.24 GHCVER=8.0.2 35 | addons: {apt: {packages: [*apt_packages, cabal-install-1.24, ghc-8.0.2], sources: [*apt_sources]}} 36 | - env: CABALVER=head GHCVER=head 37 | addons: {apt: {packages: [*apt_packages, cabal-install-head, ghc-head], sources: [*apt_sources]}} 38 | 39 | allow_failures: 40 | - env: CABALVER=head GHCVER=head 41 | 42 | before_install: 43 | - export PATH=/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:$PATH 44 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH 45 | - (which alex; which happy; which ghc; which cabal) 46 | - (ghc --version; cabal --version) 47 | - travis_retry cabal update 48 | # Unfortunately it seems we have to fetch the full repository to be able to 49 | # clone it to create our workspace. We would be OK with a shallow repository 50 | # if we could make git to clone it. 51 | - if [[ -a .git/shallow ]]; then git fetch --unshallow; fi 52 | 53 | install: 54 | - mkdir workspace 55 | - envsubst < cabal.project.travis > workspace/cabal.project 56 | - cd workspace 57 | - git clone --depth=1 .. grpc-haskell 58 | - git clone --depth=1 https://github.com/haskell/c2hs 59 | - (cd c2hs; git log -1; cabal install --prefix=$TRAVIS_BUILD_DIR/workspace/local) 60 | - export PATH=$TRAVIS_BUILD_DIR/workspace/local/bin:$PATH 61 | - which c2hs 62 | - git clone --depth=1 --recursive https://github.com/grpc/grpc grpc 63 | # reduce memory footprint with -jN. Using more memory may cause failures. 64 | - (cd grpc; git log -1; make shared_c static_c -j2) 65 | # build haskell library/executables as early as we can 66 | - cabal new-build --only-dependencies grpc 67 | # only then build the time consuming interop_server. 68 | # reduce memory footprint with -jN. Using more memory may cause failures. 69 | - (cd grpc; make interop_server -j2) 70 | # launch interop_server in the background 71 | - (grpc/bins/opt/interop_server --port=5050 &) 72 | 73 | script: 74 | - cabal new-build -v grpc 75 | # run the haskell interop client against the C++ server. 76 | # cabal-install doesn't yet have nix-style 'cabal run', find executable by hand. 77 | - export LD_LIBRARY_PATH=$TRAVIS_BUILD_DIR/workspace/grpc/libs/opt:LD_LIBRARY_PATH 78 | - dist-newstyle/build/grpc-*/build/interop_client/interop_client --server_host=localhost --server_port=5050 --test_case=all 79 | 80 | notifications: 81 | email: 82 | - kolmodin@google.com 83 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | Want to contribute? Great! First, read this page (including the small print at the end). 2 | 3 | ### Before you contribute 4 | Before we can use your code, you must sign the 5 | [Google Individual Contributor License Agreement] 6 | (https://cla.developers.google.com/about/google-individual) 7 | (CLA), which you can do online. The CLA is necessary mainly because you own the 8 | copyright to your changes, even after your contribution becomes part of our 9 | codebase, so we need your permission to use and distribute your code. We also 10 | need to be sure of various other things—for instance that you'll tell us if you 11 | know that your code infringes on other people's patents. You don't have to sign 12 | the CLA until after you've submitted your code for review and a member has 13 | approved it, but you must do it before we can put your code into our codebase. 14 | Before you start working on a larger contribution, you should get in touch with 15 | us first through the issue tracker with your idea so that we can help out and 16 | possibly guide you. Coordinating up front makes it much easier to avoid 17 | frustration later on. 18 | 19 | ### Code reviews 20 | All submissions, including submissions by project members, require review. We 21 | use GitHub pull requests for this purpose. 22 | 23 | ### The small print 24 | Contributions made by corporations are covered by a different agreement than 25 | the one above, the 26 | [Software Grant and Corporate Contributor License Agreement] 27 | (https://cla.developers.google.com/about/google-corporate). 28 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | 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 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | .PHONY: all clean 3 | 4 | all: grpc.cabal 5 | 6 | grpc.cabal: grpc.cabal.template third_party/grpc/build.yaml 7 | rm third_party/grpc/grpc.cabal || true 8 | cp grpc.cabal.template third_party/grpc/templates/ 9 | (cd third_party/grpc && ./tools/buildgen/generate_projects.sh) 10 | cp third_party/grpc/grpc.cabal grpc.cabal 11 | 12 | clean: 13 | cabal clean 14 | rm grpc.cabal 15 | 16 | # vim: noexpandtab tabstop=8 shiftwidth=8 softtabstop=8 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # gRPC for Haskell 2 | 3 | This is an experimental library for using gRPC from Haskell. It's not ready for 4 | production use. 5 | 6 | The haskell library wraps the [C library](https://github.com/grpc/grpc). Only 7 | the client side of RPCs are supported. 8 | `grpc-haskell` does not generate the RPC stubs, nor does it 9 | handle proto serialization/deserialization. Projects that generate Haskell code 10 | for serialization/deserialization may also generate stubs that use 11 | `grpc-haskell`. 12 | 13 | Client side features; 14 | - [x] Low level API for client calls, streaming and unary. 15 | - [ ] Higher level client API. 16 | 17 | ## License 18 | 19 | grpc-haskell is released under the same license as 20 | [gRPC](https://github.com/grpc/grpc), repeated in [LICENSE](LICENSE). 21 | 22 | ## Contributing 23 | 24 | Please get involved! See our [guidelines for contributing](CONTRIBUTING.md). 25 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cabal.project.travis: -------------------------------------------------------------------------------- 1 | -- For every subdirectory, build all Cabal files 2 | -- (project files support multiple Cabal files in a directory) 3 | packages: */*.cabal 4 | 5 | -- Travis CI only gives you 2 cores, but it looks like you have more. 6 | -- This makes it go slower, so let's explicitly limit to 2 cores. 7 | jobs: 2 8 | 9 | package grpc 10 | extra-include-dirs: $TRAVIS_BUILD_DIR/workspace/grpc/include 11 | extra-lib-dirs: $TRAVIS_BUILD_DIR/workspace/grpc/libs/opt 12 | flags: dev 13 | -------------------------------------------------------------------------------- /cbits/hs_byte_buffer.c: -------------------------------------------------------------------------------- 1 | /* 2 | * 3 | * Copyright 2017 gRPC authors. 4 | * 5 | * Licensed under the Apache License, Version 2.0 (the "License"); 6 | * you may not use this file except in compliance with the License. 7 | * You may obtain a copy of the License at 8 | * 9 | * http://www.apache.org/licenses/LICENSE-2.0 10 | * 11 | * Unless required by applicable law or agreed to in writing, software 12 | * distributed under the License is distributed on an "AS IS" BASIS, 13 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | * See the License for the specific language governing permissions and 15 | * limitations under the License. 16 | * 17 | */ 18 | 19 | #include 20 | #include 21 | 22 | #include 23 | 24 | grpc_byte_buffer *hs_raw_byte_buffer_create(const char *source, size_t len) { 25 | grpc_slice slice = grpc_slice_from_copied_buffer(source, len); 26 | grpc_byte_buffer *bb = grpc_raw_byte_buffer_create(&slice, 1); 27 | grpc_slice_unref(slice); 28 | return bb; 29 | } 30 | 31 | void hs_grpc_byte_buffer_reader_readall(grpc_byte_buffer_reader *reader, grpc_slice *out_slice) { 32 | grpc_slice tmp = grpc_byte_buffer_reader_readall(reader); 33 | memcpy(out_slice, &tmp, sizeof(grpc_slice)); 34 | } 35 | 36 | void hs_grpc_slice_unref(grpc_slice *slice) { 37 | grpc_slice_unref(*slice); 38 | } 39 | -------------------------------------------------------------------------------- /cbits/hs_grpc.c: -------------------------------------------------------------------------------- 1 | /* 2 | * 3 | * Copyright 2017 gRPC authors. 4 | * 5 | * Licensed under the Apache License, Version 2.0 (the "License"); 6 | * you may not use this file except in compliance with the License. 7 | * You may obtain a copy of the License at 8 | * 9 | * http://www.apache.org/licenses/LICENSE-2.0 10 | * 11 | * Unless required by applicable law or agreed to in writing, software 12 | * distributed under the License is distributed on an "AS IS" BASIS, 13 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | * See the License for the specific language governing permissions and 15 | * limitations under the License. 16 | * 17 | */ 18 | 19 | #include 20 | #include 21 | 22 | #include 23 | 24 | #include "hs_grpc.h" 25 | 26 | void hs_grpc_completion_queue_next(grpc_completion_queue *cq, 27 | gpr_timespec *deadline, 28 | grpc_event *out_event) { 29 | grpc_event event = grpc_completion_queue_next(cq, *deadline, NULL /* reserved */); 30 | memcpy(out_event, &event, sizeof(grpc_event)); 31 | } 32 | 33 | void hs_grpc_completion_queue_pluck(grpc_completion_queue *cq, 34 | void *tag, 35 | gpr_timespec *deadline, 36 | grpc_event *out_event) { 37 | grpc_event event = grpc_completion_queue_pluck(cq, tag, *deadline, NULL /* reserved */); 38 | memcpy(out_event, &event, sizeof(grpc_event)); 39 | } 40 | 41 | grpc_call *hs_grpc_channel_create_call(grpc_channel *channel, 42 | grpc_call *parent_call, 43 | uint32_t propagation_mask, 44 | grpc_completion_queue *cq, 45 | grpc_slice *method, const grpc_slice *host, 46 | gpr_timespec *deadline) { 47 | return grpc_channel_create_call(channel, parent_call, propagation_mask, cq, *method, host, *deadline, NULL /* reserved */); 48 | } 49 | 50 | void hs_grpc_slice_from_copied_buffer(const char *source, size_t length, grpc_slice *out) { 51 | grpc_slice res = grpc_slice_from_copied_buffer(source, length); 52 | memcpy(out, &res, sizeof(grpc_slice)); 53 | } 54 | 55 | void hs_grpc_slice_from_static_string(const char *source, grpc_slice *out) { 56 | grpc_slice res = grpc_slice_from_static_string(source); 57 | memcpy(out, &res, sizeof(grpc_slice)); 58 | } -------------------------------------------------------------------------------- /cbits/hs_time.c: -------------------------------------------------------------------------------- 1 | /* 2 | * 3 | * Copyright 2017 gRPC authors. 4 | * 5 | * Licensed under the Apache License, Version 2.0 (the "License"); 6 | * you may not use this file except in compliance with the License. 7 | * You may obtain a copy of the License at 8 | * 9 | * http://www.apache.org/licenses/LICENSE-2.0 10 | * 11 | * Unless required by applicable law or agreed to in writing, software 12 | * distributed under the License is distributed on an "AS IS" BASIS, 13 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | * See the License for the specific language governing permissions and 15 | * limitations under the License. 16 | * 17 | */ 18 | 19 | #include 20 | #include 21 | 22 | #include 23 | #include 24 | 25 | void hs_gpr_now(gpr_timespec *result) { 26 | gpr_timespec t = gpr_now(GPR_CLOCK_REALTIME); 27 | memcpy(result, &t, sizeof(gpr_timespec)); 28 | } 29 | 30 | void hs_gpr_timespec_free(gpr_timespec *timespec) { 31 | free(timespec); 32 | } 33 | 34 | gpr_timespec *hs_gpr_time_from_seconds(int64_t x, gpr_timespec *result) { 35 | gpr_timespec t = gpr_time_from_seconds(x, GPR_TIMESPAN); 36 | memcpy(result, &t, sizeof(gpr_timespec)); 37 | return result; 38 | } 39 | 40 | gpr_timespec *hs_gpr_time_from_millis(int64_t x, gpr_timespec *result) { 41 | gpr_timespec t = gpr_time_from_millis(x, GPR_TIMESPAN); 42 | memcpy(result, &t, sizeof(gpr_timespec)); 43 | return result; 44 | } 45 | 46 | gpr_timespec *hs_gpr_time_add(gpr_timespec *a, gpr_timespec *b, gpr_timespec *result) { 47 | gpr_timespec t = gpr_time_add(*a, *b); 48 | memcpy(result, &t, sizeof(gpr_timespec)); 49 | return result; 50 | } 51 | 52 | void hs_gpr_inf_future(gpr_timespec *result) { 53 | gpr_timespec t = gpr_inf_future(GPR_CLOCK_REALTIME); 54 | memcpy(result, &t, sizeof(gpr_timespec)); 55 | } 56 | -------------------------------------------------------------------------------- /examples/route_guide_client.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | {-# LANGUAGE OverloadedStrings #-} 16 | {-# LANGUAGE Rank2Types #-} 17 | {-# LANGUAGE ScopedTypeVariables #-} 18 | 19 | module Main where 20 | 21 | import Control.Concurrent 22 | import Control.Exception 23 | import Control.Monad 24 | import Control.Monad.IO.Class 25 | 26 | import Data.Time.Clock 27 | import Data.Word 28 | import Numeric 29 | import System.Mem 30 | 31 | import qualified Data.ByteString as B 32 | import qualified Data.ByteString.Char8 as BC8 33 | import qualified Data.ByteString.Lazy as L 34 | 35 | import Network.Grpc.Core.Call 36 | import Network.Grpc.Lib.ByteBuffer 37 | import Network.Grpc.Lib.Core 38 | import Network.Grpc.Lib.Metadata 39 | import Network.Grpc.Lib.Version 40 | 41 | getFeatureMethodName :: Slice 42 | getFeatureMethodName = "/routeguide.RouteGuide/GetFeature" 43 | 44 | listFeaturesMethodName :: Slice 45 | listFeaturesMethodName = "/routeguide.RouteGuide/ListFeatures" 46 | 47 | recordRouteMethodName :: Slice 48 | recordRouteMethodName = "/routeguide.RouteGuide/RecordRoute" 49 | 50 | routeChatMethodName :: Slice 51 | routeChatMethodName = "/routeguide.RouteGuide/RouteChat" 52 | 53 | main :: IO () 54 | main = withGrpc main' 55 | 56 | main' :: IO () 57 | main' = do 58 | BC8.putStrLn version 59 | channel <- createInsecureChannel "localhost" 10001 mempty 60 | ctx <- newClientContext channel 61 | 62 | let stub = createRouteGuideStub channel ctx 63 | 64 | measure "getFeature 1" $ do 65 | res <- runRpc (getFeature stub (Point 2 2)) 66 | print res 67 | 68 | measure "getFeature 2" $ do 69 | let stub' = stub `withCallOptions` withMetadata [Metadata "my-key" "my-value" 0] 70 | res <- runRpc (getFeature stub' (Point 42 42)) 71 | print res 72 | 73 | measure "listFeatures" $ do 74 | let rect = Rectangle (Point 0 0) (Point 16 16) 75 | features <- runRpc $ do 76 | reader <- listFeatures stub rect 77 | let 78 | readAll acc = do 79 | msg <- receiveMessage reader 80 | case msg of 81 | Just m -> do 82 | liftIO $ putStrLn ("got message: " ++ show m) 83 | readAll (m:acc) 84 | Nothing -> do 85 | liftIO $ putStrLn "No more messages" 86 | return (reverse acc) 87 | msgs <- readAll [] 88 | status <- waitForStatus reader 89 | closeCall reader 90 | return (msgs, status) 91 | print features 92 | 93 | measure "recordRoute" $ do 94 | rt <- runRpc $ do 95 | record <- recordRoute stub 96 | forM_ [ Point x x | x <- [0..20] ] $ \p -> 97 | sendMessage record (fromPoint p) 98 | sendHalfClose record 99 | x <- receiveMessage record 100 | closeCall record 101 | return x 102 | print rt 103 | 104 | measure "async routeChat" $ do 105 | RpcOk msgs <- runRpc $ do 106 | route <- routeChat stub 107 | block <- liftIO newEmptyMVar 108 | _ <- liftIO $ forkIO $ do 109 | RpcOk msgs <- runRpc (receiveAllMessages route) 110 | putMVar block msgs 111 | mapM_ (sendMessage route) notes 112 | sendHalfClose route 113 | msgs <- liftIO (takeMVar block) 114 | closeCall route 115 | return msgs 116 | putStrLn ("got " ++ show (length msgs) ++ " messages") 117 | 118 | putStrLn "*** Destroying client context" 119 | destroyClientContext ctx 120 | 121 | putStrLn "*** Destroying channel" 122 | destroyChannel channel 123 | 124 | -- ---------------------------------------------- 125 | -- Example data 126 | -- ---------------------------------------------- 127 | 128 | -- | RouteNotes 129 | notes :: [B.ByteString] 130 | notes = map (B.pack . f) 131 | [ "0a021001120d4669727374206d657373616765" 132 | , "0a021002120e5365636f6e64206d657373616765" 133 | , "0a021003120d5468697264206d657373616765" 134 | , "0a021001120e466f75727468206d657373616765" 135 | , "0a021002120d4669667468206d657373616765" 136 | , "0a021003120d5369787468206d657373616765" 137 | ] 138 | where 139 | hex :: Char -> Char -> Word8 140 | hex x y = fst . head $ readHex [x,y] 141 | f (a:b:c) = hex a b : f c 142 | f _ = [] 143 | 144 | -- ---------------------------------------------- 145 | -- Utils 146 | -- ---------------------------------------------- 147 | 148 | withGrpc :: IO a -> IO a 149 | withGrpc = bracket_ grpcInit (performMajorGC >> grpcShutdown) 150 | 151 | measure :: String -> IO a -> IO a 152 | measure desc io = bracket aquire release (\_ -> io) 153 | where 154 | aquire = do 155 | putStrLn "###" 156 | putStrLn ("### " ++ desc) 157 | putStrLn "###" 158 | getCurrentTime 159 | release start = do 160 | performMajorGC 161 | end <- getCurrentTime 162 | putStrLn (" - timing: " ++ show (diffUTCTime end start)) 163 | putStrLn "" 164 | putStrLn "" 165 | 166 | -- ------------------------------------------------------- 167 | -- A proto library should generate the stub and data types 168 | -- ------------------------------------------------------- 169 | 170 | data Rectangle = Rectangle Point Point 171 | 172 | fromRectangle :: Rectangle -> B.ByteString 173 | fromRectangle (Rectangle (Point a b) (Point c d)) = B.pack [0x0a, 0x04, 0x08, a, 0x10, b, 0x12, 0x04, 0x08, c, 0x10, d] 174 | 175 | data Point = Point Word8 Word8 176 | 177 | fromPoint :: Point -> B.ByteString 178 | fromPoint (Point a b) = B.pack [0x08, a, 0x10, b] 179 | 180 | type RouteSummary = L.ByteString 181 | 182 | data RouteGuideStub = RouteGuideStub { 183 | _channel :: Channel, 184 | _callOptions :: CallOptions, 185 | _clientContext :: ClientContext, 186 | _getFeature :: ClientContext -> CallOptions -> Point -> IO (RpcReply (UnaryResult L.ByteString)), 187 | _listFeatures :: ClientContext -> CallOptions -> Rectangle -> IO (RpcReply (Client B.ByteString L.ByteString)), 188 | _recordRoute :: ClientContext -> CallOptions -> IO (RpcReply (Client B.ByteString RouteSummary)), 189 | _routeChat :: ClientContext -> CallOptions -> IO (RpcReply (Client B.ByteString L.ByteString)) 190 | } 191 | 192 | withCallOptions :: RouteGuideStub -> CallOptions -> RouteGuideStub 193 | withCallOptions client co = client { _callOptions = co } 194 | 195 | callRpc :: IO (RpcReply a) -> Rpc a 196 | callRpc io = liftIO io >>= joinReply 197 | 198 | getFeature :: RouteGuideStub -> Point -> Rpc (UnaryResult L.ByteString) 199 | getFeature client arg = 200 | callRpc (_getFeature client (_clientContext client) (_callOptions client) arg) 201 | 202 | listFeatures :: RouteGuideStub -> Rectangle -> Rpc (Client B.ByteString L.ByteString) 203 | listFeatures client arg = 204 | callRpc (_listFeatures client (_clientContext client) (_callOptions client) arg) 205 | 206 | recordRoute :: RouteGuideStub -> Rpc (Client B.ByteString RouteSummary) 207 | recordRoute client = 208 | callRpc (_recordRoute client (_clientContext client) (_callOptions client)) 209 | 210 | routeChat :: RouteGuideStub -> Rpc (Client B.ByteString L.ByteString) 211 | routeChat client = 212 | callRpc (_routeChat client (_clientContext client) (_callOptions client)) 213 | 214 | createRouteGuideStub :: Channel -> ClientContext -> RouteGuideStub 215 | createRouteGuideStub chan ctx0 = RouteGuideStub { 216 | _channel = chan, 217 | _callOptions = mempty, 218 | _clientContext = ctx0, 219 | _getFeature = \ctx co arg -> 220 | callUnary ctx co getFeatureMethodName (fromPoint arg), 221 | _listFeatures = \ctx co arg -> 222 | callDownstream ctx co listFeaturesMethodName (fromRectangle arg), 223 | _recordRoute = \ctx co -> 224 | callUpstream ctx co recordRouteMethodName, 225 | _routeChat = \ctx co -> 226 | callBidi ctx co routeChatMethodName 227 | } 228 | -------------------------------------------------------------------------------- /grpc.cabal: -------------------------------------------------------------------------------- 1 | -- DO NOT EDIT THIS FILE. IT IS GENERATED FROM grpc.cabal.template. 2 | 3 | name: grpc 4 | version: 0.1.0.0 5 | synopsis: gRPC for Haskell 6 | description: gRPC for Haskell built on the C library. 7 | homepage: https://grpc.io 8 | license: Apache-2.0 9 | license-file: LICENSE 10 | author: Lennart Kolmodin 11 | maintainer: kolmodin@google.com 12 | copyright: The gRPC Authors 13 | category: Network 14 | build-type: Simple 15 | cabal-version: >=1.10 16 | extra-source-files: 17 | include/*.h 18 | README.md 19 | CONTRIBUTING.md 20 | 21 | flag dev 22 | Description: Build against precompiled gRPC lib 23 | default: False 24 | 25 | library 26 | build-tools: c2hs >= 0.28.1 27 | exposed-modules: 28 | Network.Grpc.Lib.ChannelArgs 29 | -- .chs modules MUST be sorted in topological order, since c2hs will 30 | -- preproccess them in the order they're listed here. 31 | Network.Grpc.Lib.Version 32 | Network.Grpc.Lib.ByteBuffer 33 | Network.Grpc.Lib.TimeSpec 34 | Network.Grpc.Lib.Metadata 35 | Network.Grpc.Lib.Core 36 | Network.Grpc.Core.Call 37 | Network.Grpc.CompletionQueue 38 | 39 | other-modules: 40 | Network.Grpc.Lib.ChannelArgsStrings 41 | Network.Grpc.Lib.PropagationBits 42 | 43 | build-depends: base >=4.6 && <4.10, ghc-prim, bytestring, unordered-containers, transformers >= 0.4.1.0 44 | hs-source-dirs: src 45 | default-language: Haskell2010 46 | ghc-options: -Wall 47 | 48 | c-sources: 49 | cbits/hs_grpc.c 50 | cbits/hs_byte_buffer.c 51 | cbits/hs_time.c 52 | 53 | include-dirs: 54 | include 55 | includes: 56 | grpc/grpc.h 57 | grpc/support/time.h 58 | hs_grpc.h 59 | hs_byte_buffer.h 60 | hs_time.h 61 | 62 | if flag(dev) 63 | extra-libraries: 64 | gpr 65 | grpc 66 | else 67 | include-dirs: 68 | third_party/grpc 69 | third_party/grpc/include 70 | third_party/grpc/third_party/boringssl/include 71 | third_party/grpc/third_party/cares 72 | third_party/grpc/third_party/cares/cares 73 | third_party/grpc/third_party/cares/config_linux 74 | cc-options: 75 | -std=c99 76 | -D_GNU_SOURCE 77 | -D_HAS_EXCEPTIONS=0 78 | -DHAVE_CONFIG_H 79 | -DNOMINMAX 80 | -DOPENSSL_NO_ASM 81 | -DOSATOMIC_USE_INLINED=1 82 | -DWIN32_LEAN_AND_MEAN 83 | -fvisibility=hidden 84 | -Wno-parentheses-equality 85 | -Wno-unused-value 86 | extra-libraries: 87 | z 88 | 89 | executable route_guide_client 90 | hs-source-dirs: examples 91 | main-is: route_guide_client.hs 92 | build-depends: base >=4.6 && <4.10, grpc, bytestring, time, transformers >= 0.4.1.0 93 | default-language: Haskell2010 94 | ghc-options: -threaded -Wall 95 | 96 | executable interop_client 97 | hs-source-dirs: tests/interop_client, tests/interop_client/proto 98 | main-is: main.hs 99 | build-depends: base >= 4.6 && <4.10, grpc, bytestring 100 | build-depends: transformers 101 | 102 | -- dependencies inherited for the proto encoder/decoder 103 | build-depends: proto-lens==0.1.*, lens-family, data-default-class, text, containers 104 | default-language: Haskell2010 105 | ghc-options: -threaded -Wall 106 | 107 | -- vim: set ft=cabal: 108 | -------------------------------------------------------------------------------- /grpc.cabal.template: -------------------------------------------------------------------------------- 1 | %YAML 1.2 2 | --- | 3 | -- DO NOT EDIT THIS FILE. IT IS GENERATED FROM grpc.cabal.template. 4 | 5 | name: grpc 6 | version: 0.1.0.0 7 | synopsis: gRPC for Haskell 8 | description: gRPC for Haskell built on the C library. 9 | homepage: https://grpc.io 10 | license: Apache-2.0 11 | license-file: LICENSE 12 | author: Lennart Kolmodin 13 | maintainer: kolmodin@google.com 14 | copyright: The gRPC Authors 15 | category: Network 16 | build-type: Simple 17 | cabal-version: >=1.10 18 | extra-source-files: 19 | include/*.h 20 | README.md 21 | CONTRIBUTING.md 22 | 23 | flag dev 24 | Description: Build against precompiled gRPC lib 25 | default: False 26 | 27 | library 28 | build-tools: c2hs >= 0.28.1 29 | exposed-modules: 30 | Network.Grpc.Lib.ChannelArgs 31 | -- .chs modules MUST be sorted in topological order, since c2hs will 32 | -- preproccess them in the order they're listed here. 33 | Network.Grpc.Lib.Version 34 | Network.Grpc.Lib.ByteBuffer 35 | Network.Grpc.Lib.TimeSpec 36 | Network.Grpc.Lib.Metadata 37 | Network.Grpc.Lib.Core 38 | Network.Grpc.Core.Call 39 | Network.Grpc.CompletionQueue 40 | 41 | other-modules: 42 | Network.Grpc.Lib.ChannelArgsStrings 43 | Network.Grpc.Lib.PropagationBits 44 | 45 | build-depends: base >=4.6 && <4.10, ghc-prim, bytestring, unordered-containers, transformers >= 0.4.1.0 46 | hs-source-dirs: src 47 | default-language: Haskell2010 48 | ghc-options: -Wall 49 | 50 | c-sources: 51 | cbits/hs_grpc.c 52 | cbits/hs_byte_buffer.c 53 | cbits/hs_time.c 54 | 55 | include-dirs: 56 | include 57 | includes: 58 | grpc/grpc.h 59 | grpc/support/time.h 60 | hs_grpc.h 61 | hs_byte_buffer.h 62 | hs_time.h 63 | 64 | if flag(dev) 65 | extra-libraries: 66 | gpr 67 | grpc 68 | else 69 | include-dirs: 70 | third_party/grpc 71 | third_party/grpc/include 72 | third_party/grpc/third_party/boringssl/include 73 | third_party/grpc/third_party/cares 74 | third_party/grpc/third_party/cares/cares 75 | third_party/grpc/third_party/cares/config_linux 76 | cc-options: 77 | -std=c99 78 | -D_GNU_SOURCE 79 | -D_HAS_EXCEPTIONS=0 80 | -DHAVE_CONFIG_H 81 | -DNOMINMAX 82 | -DOPENSSL_NO_ASM 83 | -DOSATOMIC_USE_INLINED=1 84 | -DWIN32_LEAN_AND_MEAN 85 | -fvisibility=hidden 86 | -Wno-parentheses-equality 87 | -Wno-unused-value 88 | c-sources: 89 | % for lib in [lib for lib in libs if lib.name in ["gpr", "grpc", "boringssl", "ares"]]: 90 | % for src in lib.src: 91 | third_party/grpc/${src} 92 | % endfor 93 | % endfor 94 | extra-libraries: 95 | z 96 | 97 | executable route_guide_client 98 | hs-source-dirs: examples 99 | main-is: route_guide_client.hs 100 | build-depends: base >=4.6 && <4.10, grpc, bytestring, time, transformers >= 0.4.1.0 101 | default-language: Haskell2010 102 | ghc-options: -threaded -Wall 103 | 104 | executable interop_client 105 | hs-source-dirs: tests/interop_client, tests/interop_client/proto 106 | main-is: main.hs 107 | build-depends: base >= 4.6 && <4.10, grpc, bytestring 108 | build-depends: transformers 109 | 110 | -- dependencies inherited for the proto encoder/decoder 111 | build-depends: proto-lens==0.1.*, lens-family, data-default-class, text, containers 112 | default-language: Haskell2010 113 | ghc-options: -threaded -Wall 114 | 115 | -- vim: set ft=cabal: 116 | -------------------------------------------------------------------------------- /include/hs_byte_buffer.h: -------------------------------------------------------------------------------- 1 | /* 2 | * 3 | * Copyright 2017 gRPC authors. 4 | * 5 | * Licensed under the Apache License, Version 2.0 (the "License"); 6 | * you may not use this file except in compliance with the License. 7 | * You may obtain a copy of the License at 8 | * 9 | * http://www.apache.org/licenses/LICENSE-2.0 10 | * 11 | * Unless required by applicable law or agreed to in writing, software 12 | * distributed under the License is distributed on an "AS IS" BASIS, 13 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | * See the License for the specific language governing permissions and 15 | * limitations under the License. 16 | * 17 | */ 18 | 19 | #ifndef HS_HS_BYTE_BUFFER_H 20 | #define HS_HS_BYTE_BUFFER_H 21 | 22 | #include 23 | #include 24 | 25 | grpc_byte_buffer *hs_raw_byte_buffer_create(const char *source, size_t len); 26 | 27 | void hs_grpc_byte_buffer_reader_readall(grpc_byte_buffer_reader *reader, grpc_slice *out_slice); 28 | 29 | void hs_grpc_slice_unref(grpc_slice *slice); 30 | 31 | #endif /* HS_HS_BYTE_BUFFER_H */ 32 | -------------------------------------------------------------------------------- /include/hs_grpc.h: -------------------------------------------------------------------------------- 1 | /* 2 | * 3 | * Copyright 2017 gRPC authors. 4 | * 5 | * Licensed under the Apache License, Version 2.0 (the "License"); 6 | * you may not use this file except in compliance with the License. 7 | * You may obtain a copy of the License at 8 | * 9 | * http://www.apache.org/licenses/LICENSE-2.0 10 | * 11 | * Unless required by applicable law or agreed to in writing, software 12 | * distributed under the License is distributed on an "AS IS" BASIS, 13 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | * See the License for the specific language governing permissions and 15 | * limitations under the License. 16 | * 17 | */ 18 | 19 | #ifndef HS_HS_GRPC_H 20 | #define HS_HS_GRPC_H 21 | 22 | #include 23 | #include 24 | 25 | void hs_grpc_completion_queue_next(grpc_completion_queue *cq, 26 | gpr_timespec *deadline, 27 | grpc_event *out_event); 28 | 29 | void hs_grpc_completion_queue_pluck(grpc_completion_queue *cq, 30 | void *tag, 31 | gpr_timespec *deadline, 32 | grpc_event *out_event); 33 | 34 | grpc_call *hs_grpc_channel_create_call(grpc_channel *channel, 35 | grpc_call *parent_call, 36 | uint32_t propagation_mask, 37 | grpc_completion_queue *cq, 38 | grpc_slice *method, const grpc_slice *host, 39 | gpr_timespec *deadline); 40 | 41 | void hs_grpc_slice_from_copied_buffer(const char *source, size_t length, grpc_slice *out); 42 | 43 | void hs_grpc_slice_from_static_string(const char *source, grpc_slice *out); 44 | 45 | #endif /* HS_HS_GRPC_H */ 46 | -------------------------------------------------------------------------------- /include/hs_time.h: -------------------------------------------------------------------------------- 1 | /* 2 | * 3 | * Copyright 2017 gRPC authors. 4 | * 5 | * Licensed under the Apache License, Version 2.0 (the "License"); 6 | * you may not use this file except in compliance with the License. 7 | * You may obtain a copy of the License at 8 | * 9 | * http://www.apache.org/licenses/LICENSE-2.0 10 | * 11 | * Unless required by applicable law or agreed to in writing, software 12 | * distributed under the License is distributed on an "AS IS" BASIS, 13 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | * See the License for the specific language governing permissions and 15 | * limitations under the License. 16 | * 17 | */ 18 | 19 | #ifndef HS_HS_TIME_H 20 | #define HS_HS_TIME_H 21 | 22 | #include 23 | 24 | void hs_gpr_now(gpr_timespec *result); 25 | void hs_gpr_timespec_free(gpr_timespec *timespec); 26 | gpr_timespec *hs_gpr_time_from_seconds(int64_t x, gpr_timespec *result); 27 | gpr_timespec *hs_gpr_time_from_millis(int64_t x, gpr_timespec *result); 28 | gpr_timespec *hs_gpr_time_add(gpr_timespec *a, gpr_timespec *b, gpr_timespec *result); 29 | 30 | void hs_gpr_inf_future(gpr_timespec *result); 31 | 32 | #endif /* HS_HS_TIME_H */ 33 | -------------------------------------------------------------------------------- /src/Network/Grpc/CompletionQueue.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | {-# LANGUAGE RecordWildCards #-} 16 | module Network.Grpc.CompletionQueue where 17 | 18 | import Control.Concurrent 19 | import Control.Exception 20 | import Control.Monad (unless, when) 21 | 22 | import qualified Data.HashMap.Strict as Map 23 | 24 | import Foreign.Ptr 25 | 26 | import Network.Grpc.Lib.Core 27 | import Network.Grpc.Lib.TimeSpec 28 | 29 | 30 | data Worker = Worker { 31 | cqEventMap :: EventMap, 32 | cqNextEventId :: MVar EventId, 33 | cqFinished :: MVar () 34 | } 35 | 36 | type EventId = Int 37 | type Finalizer = IO () 38 | type EventMap = MVar (Map.HashMap EventId (MVar Event, Finalizer)) 39 | 40 | data EventDesc = EventDesc (MVar Event) EventId 41 | 42 | startCompletionQueueThread :: CompletionQueue -> IO Worker 43 | startCompletionQueueThread cq = do 44 | eventMap <- newMVar Map.empty 45 | nextEventId <- newMVar 1 46 | finish <- newEmptyMVar 47 | let worker = Worker eventMap nextEventId finish 48 | _ <- forkIO $ runWorker cq worker 49 | return worker 50 | 51 | waitWorkerTermination :: Worker -> IO () 52 | waitWorkerTermination w = readMVar (cqFinished w) 53 | 54 | eventIdFromTag :: Tag -> EventId 55 | eventIdFromTag tag = tag `minusPtr` nullPtr 56 | 57 | runWorker :: CompletionQueue -> Worker -> IO () 58 | runWorker cq Worker{..} = go 59 | where 60 | go = do 61 | e <- grpcCompletionQueueNext cq gprInfFuture 62 | case e of 63 | QueueTimeOut -> return () 64 | QueueShutdown -> do 65 | completionQueueDestroy cq 66 | b <- tryPutMVar cqFinished () 67 | unless b $ putStrLn "** runWorker: error; multiple workers" 68 | QueueOpComplete _ tag -> do 69 | mDesc <- modifyMVar cqEventMap $ \eventMap -> 70 | let mDesc = Map.lookup (eventIdFromTag tag) eventMap 71 | eventMap' = Map.delete (eventIdFromTag tag) eventMap 72 | in return (eventMap', mDesc) 73 | case mDesc of 74 | Just (mEvent, finalizer) -> do 75 | exc <- try finalizer 76 | case exc of 77 | Left some -> putStrLn ("** runWorker: finalizer threw exception; " ++ show (some :: SomeException)) 78 | Right _ -> return () 79 | b <- tryPutMVar mEvent e 80 | unless b $ putStrLn "** runWorker: I wasn't first" 81 | Nothing -> putStrLn ("** runWorker: could not find tag = " ++ show (eventIdFromTag tag) ++ ", ignoring") 82 | go 83 | 84 | withEvent :: Worker -> Finalizer -> (EventDesc -> IO a) -> IO a 85 | withEvent worker finish = 86 | bracket 87 | (allocateEvent worker finish) 88 | (releaseEvent worker) 89 | 90 | allocateEvent :: Worker -> Finalizer -> IO EventDesc 91 | allocateEvent Worker{..} finish = do 92 | eventId <- modifyMVar cqNextEventId $ \eventId -> let nextEventId = eventId + 1 in nextEventId `seq` return (nextEventId, eventId) 93 | eventMVar <- newEmptyMVar 94 | modifyMVar_ cqEventMap $ \eventMap -> return $! Map.insert eventId (eventMVar, finish) eventMap 95 | return (EventDesc eventMVar eventId) 96 | 97 | releaseEvent :: Worker -> EventDesc -> IO () 98 | releaseEvent Worker{..} (EventDesc eventMVar eventId) = do 99 | b <- tryPutMVar eventMVar (error "releaseEvent: unused event cleanup") 100 | when b $ modifyMVar_ cqEventMap $ \eventMap -> return $! Map.delete eventId eventMap 101 | 102 | interruptibleWaitEvent :: EventDesc -> IO Event 103 | interruptibleWaitEvent (EventDesc mvar _) = readMVar mvar 104 | 105 | eventTag :: EventDesc -> Tag 106 | eventTag (EventDesc _ eventId) = mkTag eventId 107 | -------------------------------------------------------------------------------- /src/Network/Grpc/Core/Call.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | {-# LANGUAGE ScopedTypeVariables, OverloadedStrings, ExistentialQuantification, RecordWildCards, NamedFieldPuns #-} 16 | module Network.Grpc.Core.Call 17 | ( Deadline(..) 18 | , ClientContext 19 | , CallOptions 20 | , withAbsoluteDeadline 21 | , withRelativeDeadlineSeconds 22 | , withRelativeDeadlineMillis 23 | , withParentContext 24 | , withParentContextPropagating 25 | , withMetadata 26 | , withCompression 27 | 28 | , newClientContext 29 | , destroyClientContext 30 | , MethodName 31 | , Arg 32 | 33 | , UnaryResult(..) 34 | , callUnary 35 | , callUpstream 36 | , callDownstream 37 | , callBidi 38 | , Client 39 | , Decoder 40 | , Encoder 41 | , Rpc 42 | , runRpc 43 | , joinReply 44 | 45 | , RpcReply(..) 46 | , RpcError(..) 47 | , RpcStatus(..) 48 | 49 | , recvInitialMetadata 50 | , waitForStatus 51 | , sendMessage 52 | , receiveMessage 53 | , receiveAllMessages 54 | , closeCall 55 | , sendHalfClose 56 | , cancelCall 57 | , cancelCallWithStatus 58 | ) where 59 | 60 | 61 | import Control.Concurrent 62 | import Control.Exception 63 | import Control.Monad 64 | 65 | import qualified Data.ByteString as B 66 | import qualified Data.ByteString.Lazy as L 67 | import Data.Maybe (maybeToList) 68 | import Data.Monoid ((<>), Last(..)) 69 | import Data.IORef 70 | 71 | import Foreign.C.Types as C 72 | import qualified Foreign.Marshal.Alloc as C 73 | import qualified Foreign.Ptr as C 74 | import Foreign.Ptr (Ptr) 75 | import qualified Foreign.ForeignPtr as C 76 | import qualified Foreign.Storable as C 77 | 78 | -- transformers 79 | import Control.Monad.IO.Class 80 | import Control.Monad.Trans.Except 81 | 82 | import qualified Network.Grpc.CompletionQueue as CQ 83 | import Network.Grpc.Lib.PropagationBits 84 | {#import Network.Grpc.Lib.ByteBuffer#} (Slice, CSlice, ByteBuffer) 85 | import qualified Network.Grpc.Lib.ByteBuffer as BB 86 | {#import Network.Grpc.Lib.Metadata#} 87 | {#import Network.Grpc.Lib.TimeSpec#} 88 | {#import Network.Grpc.Lib.Core#} 89 | 90 | 91 | #include 92 | #include "hs_grpc.h" 93 | 94 | {#context lib = "grpc" prefix = "grpc" #} 95 | 96 | data Deadline 97 | = AbsoluteDeadline TimeSpec 98 | | RelativeDeadline Int -- milliseconds 99 | 100 | data ClientContext = ClientContext 101 | { ccChannel :: Channel 102 | , ccCQ :: CompletionQueue 103 | , ccWorker :: CQ.Worker 104 | } 105 | 106 | data CallOptions = CallOptions 107 | { coDeadline :: Maybe Deadline 108 | , coParentContext :: Maybe () -- todo 109 | , coPropagationMask :: Maybe PropagationMask 110 | , coMetadata :: [Metadata] 111 | , coCompressionAlgo :: Maybe CompressionAlgorithm 112 | } 113 | 114 | instance Monoid CallOptions where 115 | mempty = CallOptions Nothing Nothing Nothing [] Nothing 116 | mappend (CallOptions a b c d e) (CallOptions a' b' c' d' e') = 117 | CallOptions 118 | (getLast (Last a <> Last a')) 119 | (getLast (Last b <> Last b')) 120 | (getLast (Last c <> Last c')) 121 | (d <> d') 122 | (getLast (Last e <> Last e')) 123 | 124 | withAbsoluteDeadline :: TimeSpec -> CallOptions 125 | withAbsoluteDeadline deadline = 126 | mempty { coDeadline = Just (AbsoluteDeadline deadline) } 127 | 128 | withRelativeDeadlineSeconds :: Int -> CallOptions 129 | withRelativeDeadlineSeconds seconds = 130 | mempty { coDeadline = Just (RelativeDeadline (seconds*1000)) } 131 | 132 | withRelativeDeadlineMillis :: Int -> CallOptions 133 | withRelativeDeadlineMillis ms = 134 | mempty { coDeadline = Just (RelativeDeadline ms) } 135 | 136 | withParentContext :: () -> CallOptions 137 | withParentContext ctx = 138 | mempty { coParentContext = Just ctx } 139 | 140 | withParentContextPropagating :: () -> PropagationMask -> CallOptions 141 | withParentContextPropagating ctx prop = 142 | mempty { coParentContext = Just ctx 143 | , coPropagationMask = Just prop } 144 | 145 | withMetadata :: [Metadata] -> CallOptions 146 | withMetadata md = 147 | mempty { coMetadata = md } 148 | 149 | withCompression :: CompressionAlgorithm -> CallOptions 150 | withCompression algo = mempty { coCompressionAlgo = Just algo } 151 | 152 | compressionAsMetadata :: CompressionAlgorithm -> Metadata 153 | compressionAsMetadata algo = 154 | Metadata 155 | compressionRequestAlgorithmMdKey 156 | (compressionAlgorithmName algo) 157 | 0 158 | 159 | metadataToSend :: CallOptions -> [Metadata] 160 | metadataToSend co = 161 | maybeToList (compressionAsMetadata <$> coCompressionAlgo co) 162 | ++ coMetadata co 163 | 164 | resolveDeadline :: CallOptions -> IO TimeSpec 165 | resolveDeadline co = 166 | case coDeadline co of 167 | Nothing -> return gprInfFuture 168 | Just (AbsoluteDeadline deadline) -> return deadline 169 | Just (RelativeDeadline ms) -> 170 | millisFromNow (fromIntegral ms) 171 | 172 | newClientContext :: Channel -> IO ClientContext 173 | newClientContext chan = do 174 | cq <- completionQueueCreateForNext reservedPtr 175 | cqt <- CQ.startCompletionQueueThread cq 176 | return (ClientContext chan cq cqt) 177 | 178 | destroyClientContext :: ClientContext -> IO () 179 | destroyClientContext ClientContext{ccCQ, ccWorker} = do 180 | completionQueueShutdown ccCQ 181 | CQ.waitWorkerTermination ccWorker 182 | 183 | type MethodName = Slice 184 | type Arg = B.ByteString 185 | 186 | reservedPtr :: Ptr () 187 | reservedPtr = C.nullPtr 188 | 189 | data UnaryResult a = UnaryResult [Metadata] [Metadata] a deriving Show 190 | 191 | callUnary :: ClientContext -> CallOptions -> MethodName -> Arg -> IO (RpcReply (UnaryResult L.ByteString)) 192 | callUnary ctx@ClientContext{ccChannel, ccCQ} co method arg = do 193 | deadline <- resolveDeadline co 194 | bracket (grpcChannelCreateCall (cChannel ccChannel) C.nullPtr propagateDefaults ccCQ method (cHost ccChannel) deadline) grpcCallUnref $ \call0 -> newMVar call0 >>= \mcall -> do 195 | crw <- newClientReaderWriter ctx mcall 196 | 197 | sendInitOp <- opSendInitialMetadata (metadataToSend co) 198 | sendCloseOp <- opSendCloseFromClient 199 | sendMessageOp <- opSendMessage arg 200 | recvStatusOp <- opRecvStatusOnClient crw 201 | recvMessageOp <- opRecvMessage 202 | recvInitialMetadataOp <- opRecvInitialMetadata crw 203 | 204 | res <- callBatch crw [ 205 | OpX sendInitOp 206 | , OpX sendCloseOp 207 | , OpX recvInitialMetadataOp 208 | , OpX recvMessageOp 209 | , OpX sendMessageOp 210 | , OpX recvStatusOp 211 | ] 212 | case res of 213 | RpcOk _ -> do 214 | (RpcStatus trailMD status statusDetails) <- opRead recvStatusOp 215 | case status of 216 | StatusOk -> do 217 | initMD <- opRead recvInitialMetadataOp 218 | answ <- opRead recvMessageOp 219 | let answ' = maybe L.empty id answ 220 | return (RpcOk (UnaryResult initMD trailMD answ')) 221 | _ -> return (RpcError (StatusError status statusDetails)) 222 | RpcError err -> return (RpcError err) 223 | 224 | callDownstream :: ClientContext -> CallOptions -> MethodName -> Arg -> IO (RpcReply (Client B.ByteString L.ByteString)) 225 | callDownstream ctx@ClientContext{ccChannel, ccCQ} co method arg = do 226 | deadline <- resolveDeadline co 227 | mcall <- grpcChannelCreateCall (cChannel ccChannel) C.nullPtr propagateDefaults ccCQ method (cHost ccChannel) deadline >>= newMVar 228 | 229 | crw <- newClientReaderWriter ctx mcall 230 | let client = RpcOk (Client crw defaultEncoder defaultDecoder) 231 | 232 | sendInitOp <- opSendInitialMetadata (metadataToSend co) 233 | sendCloseOp <- opSendCloseFromClient 234 | sendMessageOp <- opSendMessage arg 235 | res <- callBatch crw [ 236 | OpX sendInitOp 237 | , OpX sendCloseOp 238 | , OpX sendMessageOp 239 | ] 240 | case res of 241 | RpcOk _ -> return client 242 | RpcError _ -> do 243 | clientCloseCall crw 244 | stat <- clientWaitForStatus crw 245 | case stat of 246 | RpcOk (RpcStatus _ code msg) -> return (RpcError (StatusError code msg)) 247 | RpcError err -> return (RpcError err) 248 | 249 | callUpstream :: ClientContext -> CallOptions -> MethodName -> IO (RpcReply (Client B.ByteString L.ByteString)) 250 | callUpstream ctx@ClientContext{ccChannel, ccCQ} co method = do 251 | deadline <- resolveDeadline co 252 | mcall <- grpcChannelCreateCall (cChannel ccChannel) C.nullPtr propagateDefaults ccCQ method (cHost ccChannel) deadline >>= newMVar 253 | 254 | crw <- newClientReaderWriter ctx mcall 255 | let client = RpcOk (Client crw defaultEncoder defaultDecoder) 256 | sendInitOp <- opSendInitialMetadata (metadataToSend co) 257 | res <- callBatch crw [ OpX sendInitOp ] 258 | 259 | case res of 260 | RpcOk _ -> return client 261 | RpcError _ -> do 262 | clientCloseCall crw 263 | stat <- clientWaitForStatus crw 264 | case stat of 265 | RpcOk (RpcStatus _ code msg) -> return (RpcError (StatusError code msg)) 266 | RpcError err -> return (RpcError err) 267 | 268 | callBidi :: ClientContext -> CallOptions -> MethodName -> IO (RpcReply (Client B.ByteString L.ByteString)) 269 | callBidi ctx@ClientContext{ccChannel, ccCQ} co method = do 270 | deadline <- resolveDeadline co 271 | mcall <- grpcChannelCreateCall (cChannel ccChannel) C.nullPtr propagateDefaults ccCQ method (cHost ccChannel) deadline >>= newMVar 272 | 273 | crw <- newClientReaderWriter ctx mcall 274 | let client = Client crw defaultEncoder defaultDecoder 275 | sendInitOp <- opSendInitialMetadata (metadataToSend co) 276 | res <- callBatch crw [ OpX sendInitOp ] 277 | 278 | case res of 279 | RpcOk _ -> return (RpcOk client) 280 | RpcError _ -> do 281 | clientCloseCall crw 282 | stat <- clientWaitForStatus crw 283 | case stat of 284 | RpcOk (RpcStatus _ code msg) -> return (RpcError (StatusError code msg)) 285 | RpcError err -> return (RpcError err) 286 | 287 | data Client req resp = Client 288 | { clientCrw :: ClientReaderWriter 289 | , clientEncoder :: Encoder req 290 | , clientDecoder :: Decoder resp 291 | } 292 | 293 | type Decoder a = L.ByteString -> IO (RpcReply a) 294 | type Encoder a = a -> IO (RpcReply B.ByteString) 295 | 296 | defaultDecoder :: L.ByteString -> IO (RpcReply L.ByteString) 297 | defaultDecoder bs = return (RpcOk bs) 298 | 299 | defaultEncoder :: B.ByteString -> IO (RpcReply B.ByteString) 300 | defaultEncoder bs = return (RpcOk bs) 301 | 302 | data ClientReaderWriter = ClientReaderWriter { 303 | context :: ClientContext, 304 | callMVar_ :: MVar Call, 305 | initialMDRef :: !(IORef (Maybe [Metadata])), 306 | trailingMDRef :: !(IORef (Maybe [Metadata])), 307 | statusFromServer :: !(MVar RpcStatus) 308 | } 309 | 310 | newClientReaderWriter :: ClientContext -> MVar Call -> IO ClientReaderWriter 311 | newClientReaderWriter ctx mcall = do 312 | initMD <- newIORef Nothing 313 | trailMD <- newIORef Nothing 314 | status <- newEmptyMVar 315 | return (ClientReaderWriter ctx mcall initMD trailMD status) 316 | 317 | data OpX = forall t. OpX (OpT t) 318 | 319 | data OpArray = OpArray { opArrPtr :: !GrpcOpPtr 320 | , opArrLen :: !CULong 321 | , opArrFinishAndFree :: !(IO ()) 322 | } 323 | 324 | toArray :: [OpX] -> IO OpArray 325 | toArray ops = do 326 | aptr <- C.mallocBytes (length ops * {#sizeof grpc_op#}) 327 | let ptrs = iterate (`C.plusPtr` {#sizeof grpc_op#}) aptr 328 | ops' = concatMap (\(OpX op) -> opAdd op) ops 329 | free = C.free aptr >> sequence_ (map (\(OpX op) -> opFinish op) ops) 330 | write op p = do 331 | {#set grpc_op->flags#} p 0 332 | {#set grpc_op->reserved#} p C.nullPtr 333 | op p 334 | zipWithM_ write ops' ptrs 335 | return $! OpArray aptr (fromIntegral $ length ops) free 336 | 337 | callBatch :: ClientReaderWriter -> [OpX] -> IO (RpcReply ()) 338 | callBatch crw ops = do 339 | let ctx = context crw 340 | arr <- toArray ops 341 | let onBatchComplete = opArrFinishAndFree arr 342 | CQ.withEvent (ccWorker ctx) onBatchComplete $ \eDesc -> do 343 | callStatus <- withMVar (callMVar_ crw) $ \call -> 344 | grpcCallStartBatch call (opArrPtr arr) (opArrLen arr) (CQ.eventTag eDesc) reservedPtr 345 | case callStatus of 346 | CallOk -> do 347 | e <- CQ.interruptibleWaitEvent eDesc 348 | case e of 349 | QueueOpComplete OpSuccess _ -> return (RpcOk ()) 350 | QueueOpComplete OpError _ -> return (RpcError (Error "callBatch: op error")) 351 | QueueTimeOut -> return (RpcError DeadlineExceeded) 352 | QueueShutdown -> return (RpcError (Error "queue shutdown")) 353 | _ -> do 354 | return (RpcError (CallErrorStatus callStatus)) 355 | 356 | data OpT out = Op 357 | { opAdd :: [Ptr GrpcOp -> IO ()] 358 | , opValue :: IORef out 359 | , opFinish :: IO () 360 | } 361 | 362 | opRead :: OpT a -> IO a 363 | opRead op = readIORef (opValue op) 364 | 365 | opRecvInitialMetadata :: ClientReaderWriter -> IO (OpT [Metadata]) 366 | opRecvInitialMetadata crw = do 367 | arr <- mallocMetadataArray 368 | value <- newIORef (error "opRecvInitialMetadata never finished") 369 | let 370 | add = 371 | [ \p -> do 372 | {#set grpc_op->op#} p (fromIntegral (fromEnum OpRecvInitialMetadata)) 373 | {#set grpc_op->data.recv_initial_metadata.recv_initial_metadata#} p arr 374 | ] 375 | finish = do 376 | mds <- readMetadataArray arr 377 | writeIORef (initialMDRef crw) (Just mds) 378 | writeIORef value mds 379 | freeMetadataArray arr 380 | return (Op add value finish) 381 | 382 | opSendMessage :: B.ByteString -> IO (OpT ()) 383 | opSendMessage bs = do 384 | bb <- BB.fromByteString bs 385 | value <- newIORef () 386 | let 387 | add = 388 | [ \p -> do 389 | {#set grpc_op->op#} p (fromIntegral (fromEnum OpSendMessage)) 390 | {#set grpc_op->data.send_message.send_message#} p bb 391 | ] 392 | finish = 393 | BB.byteBufferDestroy bb 394 | return (Op add value finish) 395 | 396 | opRecvMessage :: IO (OpT (Maybe L.ByteString)) 397 | opRecvMessage = do 398 | bbptr <- C.malloc :: IO (Ptr (Ptr BB.CByteBuffer)) 399 | value <- newIORef Nothing 400 | let 401 | add = 402 | [ \p -> do 403 | {#set grpc_op->op#} p (fromIntegral (fromEnum OpRecvMessage)) 404 | {#set grpc_op->data.recv_message.recv_message#} p bbptr 405 | ] 406 | finish = do 407 | bb <- C.peek bbptr 408 | C.free bbptr 409 | writeIORef value =<< if bb /= C.nullPtr 410 | then do 411 | lbs <- BB.toLazyByteString bb 412 | BB.byteBufferDestroy bb 413 | return (Just lbs) 414 | else return Nothing 415 | return (Op add value finish) 416 | 417 | opSendInitialMetadata :: [Metadata] -> IO (OpT ()) 418 | opSendInitialMetadata elems = do 419 | (mdArrPtr, free) <- mallocMetadata elems 420 | value <- newIORef () 421 | let 422 | add = 423 | [ \p -> do 424 | {#set grpc_op->op#} p (fromIntegral (fromEnum OpSendInitialMetadata)) 425 | {#set grpc_op->data.send_initial_metadata.count#} p (fromIntegral (length elems)) 426 | {#set grpc_op->data.send_initial_metadata.metadata#} p (C.castPtr mdArrPtr) 427 | {#set grpc_op->data.send_initial_metadata.maybe_compression_level.is_set#} p 0 428 | {#set grpc_op->data.send_initial_metadata.maybe_compression_level.level#} p 0 429 | ] 430 | finish = do 431 | free 432 | return (Op add value finish) 433 | 434 | opRecvStatusOnClient :: ClientReaderWriter -> IO (OpT RpcStatus) 435 | opRecvStatusOnClient (ClientReaderWriter{..}) = do 436 | trailingMetadataArrPtr <- mallocMetadataArray 437 | statusCodePtr <- C.malloc :: IO (Ptr StatusCodeT) 438 | statusSlice <- BB.mallocSlice 439 | value <- newIORef (error "opRecvStatusOnClient never ran") 440 | let 441 | add = 442 | [ \p -> do 443 | {#set grpc_op->op#} p (fromIntegral (fromEnum OpRecvStatusOnClient)) 444 | {#set grpc_op->data.recv_status_on_client.trailing_metadata#} p trailingMetadataArrPtr 445 | {#set grpc_op->data.recv_status_on_client.status#} p statusCodePtr 446 | C.withForeignPtr statusSlice $ \statusSlice' -> {#set grpc_op->data.recv_status_on_client.status_details#} p statusSlice' 447 | ] 448 | finish = do 449 | trailingMd <- readMetadataArray trailingMetadataArrPtr 450 | statusCode <- fmap toStatusCode (C.peek statusCodePtr) 451 | statusDetails <- BB.toByteString statusSlice 452 | let status = RpcStatus trailingMd statusCode statusDetails 453 | writeIORef value status 454 | putMVar statusFromServer status 455 | free 456 | free = do 457 | freeMetadataArray trailingMetadataArrPtr 458 | C.free statusCodePtr 459 | C.finalizeForeignPtr statusSlice 460 | return (Op add value finish) 461 | 462 | opSendCloseFromClient :: IO (OpT ()) 463 | opSendCloseFromClient = do 464 | value <- newIORef () 465 | let 466 | add = 467 | [ \p -> do 468 | {#set grpc_op->op#} p (fromIntegral (fromEnum OpSendCloseFromClient)) 469 | ] 470 | finish = 471 | return () 472 | return (Op add value finish) 473 | 474 | clientWaitForInitialMetadata :: ClientReaderWriter -> IO (RpcReply [Metadata]) 475 | clientWaitForInitialMetadata crw@(ClientReaderWriter { .. }) = do 476 | initMD <- readIORef initialMDRef 477 | case initMD of 478 | Just md -> return (RpcOk md) 479 | Nothing -> do 480 | recvInitialMetadataOp <- opRecvInitialMetadata crw 481 | res <- callBatch crw [ OpX recvInitialMetadataOp ] 482 | case res of 483 | RpcOk _ -> do 484 | md <- opRead recvInitialMetadataOp 485 | writeIORef initialMDRef (Just md) 486 | return (RpcOk md) 487 | RpcError err -> 488 | return (RpcError err) 489 | 490 | clientRead :: ClientReaderWriter -> IO (RpcReply (Maybe L.ByteString)) 491 | clientRead crw = do 492 | _ <- clientWaitForInitialMetadata crw 493 | recvMessage crw 494 | 495 | recvMessage :: ClientReaderWriter -> IO (RpcReply (Maybe L.ByteString)) 496 | recvMessage crw = do 497 | recvMessageOp <- opRecvMessage 498 | res <- callBatch crw [ OpX recvMessageOp ] 499 | case res of 500 | RpcOk _ -> do 501 | bs <- opRead recvMessageOp 502 | return (RpcOk bs) 503 | RpcError err -> do 504 | putStrLn "recvMessage: callBatch failed" 505 | return (RpcError err) 506 | 507 | clientWaitForStatus :: ClientReaderWriter -> IO (RpcReply RpcStatus) 508 | clientWaitForStatus crw = do 509 | prev <- tryReadMVar (statusFromServer crw) 510 | case prev of 511 | Just stat -> do 512 | return (RpcOk stat) 513 | Nothing -> do 514 | statusOp <- opRecvStatusOnClient crw 515 | res <- callBatch crw [ OpX statusOp ] 516 | case res of 517 | RpcOk _ -> do 518 | status <- opRead statusOp 519 | return (RpcOk status) 520 | RpcError err -> 521 | return (RpcError err) 522 | 523 | clientWrite :: ClientReaderWriter -> B.ByteString -> IO (RpcReply ()) 524 | clientWrite crw@(ClientReaderWriter{..}) arg = do 525 | sendMessageOp <- opSendMessage arg 526 | callBatch crw [ OpX sendMessageOp ] 527 | 528 | clientSendHalfClose :: ClientReaderWriter -> IO (RpcReply ()) 529 | clientSendHalfClose crw@(ClientReaderWriter{..}) = do 530 | sendCloseOp <- opSendCloseFromClient 531 | callBatch crw [ OpX sendCloseOp ] 532 | 533 | clientCloseCall :: ClientReaderWriter -> IO () 534 | clientCloseCall crw@ClientReaderWriter{..} = do 535 | _ <- clientWaitForStatus crw 536 | modifyMVar_ callMVar_ $ \call -> do 537 | grpcCallUnref call 538 | return (error "grpcCallUnref called on this Call") 539 | 540 | clientCancelCall :: ClientReaderWriter -> IO (RpcReply ()) 541 | clientCancelCall ClientReaderWriter{..} = do 542 | err <- withMVar callMVar_ $ \call -> do 543 | grpcCallCancel call reservedPtr 544 | case err of 545 | CallOk -> return (RpcOk ()) 546 | _ -> return (RpcError (CallErrorStatus err)) 547 | 548 | clientCancelCallWithStatus :: ClientReaderWriter -> StatusCode -> B.ByteString -> IO (RpcReply ()) 549 | clientCancelCallWithStatus ClientReaderWriter{..} status details = do 550 | err <- withMVar callMVar_ $ \call -> do 551 | grpcCallCancelWithStatus call status details reservedPtr 552 | case err of 553 | CallOk -> return (RpcOk ()) 554 | _ -> return (RpcError (CallErrorStatus err)) 555 | 556 | type Rpc a = ExceptT RpcError IO a 557 | 558 | joinReply :: RpcReply a -> Rpc a 559 | joinReply (RpcOk a) = return a 560 | joinReply (RpcError err) = throwE err 561 | 562 | runRpc :: Rpc a -> IO (RpcReply a) 563 | runRpc m = do 564 | e <- runExceptT m 565 | case e of 566 | Left err -> return (RpcError err) 567 | Right a -> return (RpcOk a) 568 | 569 | clientRWOp :: Client req resp -> (ClientReaderWriter -> IO a) -> Rpc a 570 | clientRWOp client act = 571 | liftIO (act (clientCrw client)) 572 | 573 | joinClientRWOp :: Client req resp -> (ClientReaderWriter -> IO (RpcReply a)) -> Rpc a 574 | joinClientRWOp client act = do 575 | x <- clientRWOp client act 576 | joinReply x 577 | 578 | branchOnClientStatus :: Client req resp 579 | -> Rpc a 580 | -> Rpc a 581 | -> (StatusCode -> B.ByteString -> Rpc a) 582 | -> Rpc a 583 | branchOnClientStatus client onProcessing onSuccess onFail = do 584 | status <- clientRWOp client (tryReadMVar . statusFromServer) 585 | case status of 586 | Nothing -> onProcessing 587 | Just (RpcStatus _ code msg) 588 | | code == StatusOk -> onSuccess 589 | | otherwise -> onFail code msg 590 | 591 | throwIfErrorStatus :: Client req resp -> Rpc () 592 | throwIfErrorStatus client = 593 | branchOnClientStatus 594 | client 595 | (return ()) 596 | (return ()) 597 | (\code msg -> throwE (StatusError code msg)) 598 | 599 | recvInitialMetadata :: Client req resp -> Rpc [Metadata] 600 | recvInitialMetadata client = do 601 | joinClientRWOp client clientWaitForInitialMetadata 602 | 603 | waitForStatus :: Client req resp -> Rpc RpcStatus 604 | waitForStatus client = do 605 | _ <- clientRWOp client clientWaitForInitialMetadata 606 | joinClientRWOp client clientWaitForStatus 607 | 608 | receiveMessage :: Client req resp -> Rpc (Maybe resp) 609 | receiveMessage client = do 610 | throwIfErrorStatus client 611 | msg <- joinClientRWOp client clientRead 612 | case msg of 613 | Nothing -> return Nothing 614 | Just x -> do 615 | let decoder = clientDecoder client 616 | liftM Just (joinReply =<< liftIO (decoder x)) 617 | 618 | receiveAllMessages :: Client req resp -> Rpc [resp] 619 | receiveAllMessages client = do 620 | let 621 | decoder = clientDecoder client 622 | go acc = do 623 | value <- joinClientRWOp client clientRead 624 | case value of 625 | Just x -> do 626 | y <- joinReply =<< (liftIO (decoder x)) 627 | go (y:acc) 628 | Nothing -> return (reverse acc) 629 | go [] 630 | 631 | sendMessage :: Client req resp -> req -> Rpc () 632 | sendMessage client req = do 633 | throwIfErrorStatus client 634 | let encoder = clientEncoder client 635 | bs <- joinReply =<< liftIO (encoder req) 636 | joinClientRWOp client (\crw -> clientWrite crw bs) 637 | 638 | sendHalfClose :: Client req resp -> Rpc () 639 | sendHalfClose client = do 640 | throwIfErrorStatus client 641 | joinClientRWOp client clientSendHalfClose 642 | 643 | closeCall :: Client req resp -> Rpc () 644 | closeCall client = do 645 | status <- waitForStatus client 646 | clientRWOp client clientCloseCall 647 | case status of 648 | RpcStatus _ StatusOk _ -> return () 649 | RpcStatus _ code detail -> throwE (StatusError code detail) 650 | 651 | -- | Called by clients to cancel an RPC on the server. 652 | -- Can be called multiple times, from any thread. 653 | cancelCall :: Client req resp -> Rpc () 654 | cancelCall client = do 655 | _ <- clientRWOp client clientCancelCall 656 | return () 657 | 658 | -- | Called by clients to cancel an RPC on the server. 659 | -- Can be called multiple times, from any thread. 660 | -- If a status has not been received for the call, set it to the status code 661 | -- and description passed in. 662 | -- Importantly, this function does not send status nor description to the 663 | -- remote endpoint. 664 | cancelCallWithStatus :: Client req resp -> StatusCode -> B.ByteString -> Rpc () 665 | cancelCallWithStatus client status details = 666 | joinClientRWOp client (\crw -> clientCancelCallWithStatus crw status details) 667 | 668 | data RpcStatus = RpcStatus [Metadata] StatusCode B.ByteString 669 | deriving Show 670 | 671 | data RpcReply a 672 | = RpcOk a 673 | | RpcError RpcError 674 | deriving Show 675 | 676 | data RpcError 677 | = DeadlineExceeded 678 | | Cancelled 679 | | Error String 680 | | CallErrorStatus CallError 681 | | StatusError StatusCode B.ByteString 682 | deriving Show 683 | -------------------------------------------------------------------------------- /src/Network/Grpc/Lib/ByteBuffer.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | {-# LANGUAGE ForeignFunctionInterface, MagicHash, TypeSynonymInstances, FlexibleInstances #-} 16 | module Network.Grpc.Lib.ByteBuffer 17 | ( CByteBuffer 18 | , ByteBuffer 19 | 20 | , Slice 21 | , CSlice 22 | , sliceFromCopy 23 | , toByteString 24 | , grpcSliceRef 25 | , grpcSliceUnref 26 | , sliceFromStaticByteString 27 | , grpcSliceFromCopiedBuffer 28 | , mallocSlice 29 | 30 | , fromByteString 31 | , toLazyByteString 32 | , byteBufferLength 33 | , mallocCByteBuffer 34 | , freeCByteBuffer 35 | , byteBufferDestroy 36 | 37 | , CByteBufferReader 38 | ) where 39 | 40 | import Foreign.C.Types 41 | import Foreign.ForeignPtr 42 | import Foreign.Marshal.Alloc as C 43 | import Foreign.Ptr 44 | 45 | import Control.Exception (finally) 46 | 47 | import Data.ByteString (ByteString) 48 | import qualified Data.ByteString as B 49 | import qualified Data.ByteString.Char8 as B8 50 | import qualified Data.ByteString.Internal as B 51 | import qualified Data.ByteString.Lazy as L 52 | 53 | import Data.String 54 | 55 | import GHC.Prim (Addr#) 56 | import GHC.Ptr (Ptr(..)) 57 | 58 | import System.IO.Unsafe ( unsafePerformIO ) 59 | 60 | #include 61 | #include 62 | #include 63 | #include "hs_byte_buffer.h" 64 | #include "hs_grpc.h" 65 | 66 | {#context lib = "grpc" prefix = "grpc" #} 67 | 68 | data CByteBuffer 69 | {#pointer *byte_buffer as ByteBuffer -> CByteBuffer#} 70 | 71 | mallocCByteBuffer :: IO (Ptr CByteBuffer) 72 | mallocCByteBuffer = 73 | C.mallocBytes {#sizeof grpc_byte_buffer#} 74 | 75 | freeCByteBuffer :: Ptr CByteBuffer -> IO () 76 | freeCByteBuffer = 77 | C.free 78 | 79 | {#fun unsafe byte_buffer_destroy as ^ 80 | {`ByteBuffer'} -> `()' #} 81 | 82 | data CByteBufferReader 83 | {#pointer *byte_buffer_reader as ByteBufferReader -> CByteBufferReader#} 84 | 85 | data CSlice 86 | {#pointer *grpc_slice as Slice foreign -> CSlice #} 87 | 88 | type SizeT = {#type size_t#} 89 | 90 | fromByteString :: ByteString -> IO ByteBuffer 91 | fromByteString = hsRawByteBufferCreate 92 | 93 | withByteString :: ByteString -> ((Ptr CChar, CULong) -> IO a) -> IO a 94 | withByteString bs act = do 95 | let (fPtr, offset, len) = B.toForeignPtr bs 96 | withForeignPtr fPtr $ \ptr -> act (ptr `plusPtr` offset, fromIntegral len) 97 | 98 | {#fun unsafe hs_raw_byte_buffer_create as ^ 99 | {withByteString* `ByteString'&} -> `ByteBuffer' #} 100 | 101 | toByteString :: Slice -> IO ByteString 102 | toByteString slice0 = withForeignPtr slice0 $ \slice -> do 103 | refcount <- {#get grpc_slice->refcount#} slice 104 | if refcount == nullPtr 105 | then fromInlined slice 106 | else fromRefcounted slice 107 | where 108 | fromInlined slice = do 109 | len <- {#get grpc_slice->data.inlined.length#} slice 110 | ptr <- {#get grpc_slice->data.inlined.bytes#} slice 111 | B.packCStringLen (castPtr ptr, fromIntegral len) 112 | fromRefcounted slice = do 113 | len <- {#get grpc_slice->data.refcounted.length#} slice 114 | ptr <- {#get grpc_slice->data.refcounted.bytes#} slice 115 | B.packCStringLen (castPtr ptr, fromIntegral len) 116 | 117 | mallocSlice :: IO Slice 118 | mallocSlice = 119 | mallocForeignPtrBytes {#sizeof grpc_slice#} 120 | 121 | sliceFromCopy :: ByteString -> IO Slice 122 | sliceFromCopy bs = do 123 | slice <- mallocSlice 124 | grpcSliceFromCopiedBuffer bs slice 125 | addForeignPtrFinalizer grpcSlideUnrefFinalizer slice 126 | return slice 127 | 128 | instance IsString Slice where 129 | fromString = unsafePerformIO . sliceFromCopy . B8.pack 130 | {-# NOINLINE fromString #-} 131 | 132 | {#fun unsafe hs_grpc_slice_from_copied_buffer as grpcSliceFromCopiedBuffer 133 | { withByteString* `ByteString'& 134 | , `Slice' } -> `()' #} 135 | 136 | -- | Make a Slice without a reference counter. 137 | sliceFromStaticByteString :: ByteString -> IO Slice 138 | sliceFromStaticByteString bs = do 139 | slice <- mallocSlice 140 | -- Since the underlying string is static, there is no need to 141 | -- call grpc_slice_unref. All we need to do is to free the memory for 142 | -- the grpc_slice itself. 143 | withByteString bs $ \(ptr, _) -> grpcSliceFromStaticString ptr slice 144 | return slice 145 | 146 | -- | Make a Slice without a reference counter. 147 | sliceFromStaticString# :: Addr# -> IO Slice 148 | sliceFromStaticString# addr# = do 149 | slice <- mallocSlice 150 | grpcSliceFromStaticString (Ptr addr#) slice 151 | return slice 152 | 153 | {#fun unsafe hs_grpc_slice_from_static_string as grpcSliceFromStaticString 154 | { id `Ptr CChar' 155 | , `Slice' } -> `()' #} 156 | 157 | toLazyByteString :: ByteBuffer -> IO L.ByteString 158 | toLazyByteString bb = 159 | allocaByteBufferReader $ \ bbr -> do 160 | slice <- mallocSlice 161 | ok <- byteBufferReaderInit bbr bb 162 | if ok 163 | then finally (go bbr slice []) (byteBufferReaderDestroy bbr) 164 | else return L.empty -- TODO: assert 165 | where 166 | go bbr slice acc = do 167 | ok <- byteBufferReaderNext bbr slice 168 | if ok 169 | then do 170 | bs <- toByteString slice 171 | grpcSliceUnref slice 172 | go bbr slice (bs:acc) 173 | else return $! L.fromChunks (reverse acc) 174 | 175 | allocaByteBufferReader :: (ByteBufferReader -> IO a) -> IO a 176 | allocaByteBufferReader act = do 177 | allocaBytes {#sizeof grpc_byte_buffer_reader#} $ \p -> act p 178 | 179 | -- | Initialize a 'ByteBufferReader' for the given 'ByteBuffer'. 180 | -- If return True, the initialization was successful and the caller is 181 | -- responsible for calling 'byteBufferReaderDestroy'. 182 | {#fun unsafe byte_buffer_reader_init as ^ 183 | {`ByteBufferReader', `ByteBuffer'} -> `Bool' #} 184 | 185 | -- | Updates the 'Slice' with the next piece of data from the reader 186 | -- and returns True. Returns False at the end of the stream. The caller 187 | -- is responsible for calling 'grpc_slice_unref' on the result. 188 | {#fun unsafe byte_buffer_reader_next as ^ 189 | {`ByteBufferReader', `Slice'} -> `Bool'#} 190 | 191 | -- | Clean up a 'ByteBufferReader'. 192 | {#fun unsafe byte_buffer_reader_destroy as ^ 193 | {`ByteBufferReader'} -> `()'#} 194 | 195 | -- | /O(1)/. Return the length of a 'ByteBuffer'. 196 | {#fun unsafe byte_buffer_length as ^ 197 | {`ByteBuffer'} -> `SizeT' id #} 198 | 199 | -- | Updates the 'Slice' with a slice of all the data merged. 200 | {#fun unsafe hs_grpc_byte_buffer_reader_readall as ^ 201 | {`ByteBufferReader', `Slice'} -> `()' #} 202 | 203 | -- | Ref a 'Slice'. When the reference counter reaches zero, the slice will 204 | -- be deallocated. 205 | {#fun unsafe grpc_slice_ref as ^ 206 | {%`Slice'} -> `()' #} 207 | 208 | -- | Unref a 'Slice'. When the reference counter reaches zero, the slice will 209 | -- be deallocated. 210 | {#fun unsafe grpc_slice_unref as ^ 211 | {%`Slice'} -> `()' #} 212 | 213 | foreign import ccall "hs_byte_buffer.h &hs_grpc_slice_unref" 214 | grpcSlideUnrefFinalizer :: FunPtr (Ptr CSlice -> IO ()) 215 | -------------------------------------------------------------------------------- /src/Network/Grpc/Lib/ChannelArgs.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | {-# LANGUAGE OverloadedStrings #-} 16 | 17 | module Network.Grpc.Lib.ChannelArgs 18 | ( enableSensus 19 | , disableSensus 20 | , enableLoadReporting 21 | , disableLoadReporting 22 | , maxConcurrentStreams 23 | , maxReceiveMessageLength 24 | , maxSendMessageLength 25 | , http2InitialSequenceNumber 26 | , http2StreamLookaheadBytes 27 | , http2HpackTableSizeDecoder 28 | , http2HpackTableSizeEncoder 29 | , http2MaxFrameSize 30 | , defaultAuthority 31 | , primaryUserAgentString 32 | , secondaryUserAgentString 33 | , maxReconnectBackoffMs 34 | , initialReconnectBackoffMs 35 | , sslTargetNameOverrideArg 36 | , maxMetadataSize 37 | , allowReusePort 38 | , disableReusePort 39 | ) where 40 | 41 | import qualified Data.ByteString as B 42 | 43 | import qualified Data.HashMap.Strict as Map 44 | 45 | import Network.Grpc.Lib.Core 46 | import Network.Grpc.Lib.ChannelArgsStrings 47 | 48 | 49 | -- | Enable census for tracing and stats collection. 50 | enableSensus :: ChannelArgs 51 | enableSensus = argB grpcArg_EnableSensus True 52 | 53 | -- | Disable census for tracing and stats collection. 54 | disableSensus :: ChannelArgs 55 | disableSensus = argB grpcArg_EnableSensus False 56 | 57 | -- | Enable load reporting. 58 | enableLoadReporting :: ChannelArgs 59 | enableLoadReporting = argB grpcArg_EnableLoadReporting True 60 | 61 | -- | Disable load reporting. 62 | disableLoadReporting :: ChannelArgs 63 | disableLoadReporting = argB grpcArg_EnableLoadReporting False 64 | 65 | -- | Maximum number of concurrent incoming streams to allow on a http2 66 | -- connection. 67 | maxConcurrentStreams :: ArgInt -> ChannelArgs 68 | maxConcurrentStreams = argI grpcArg_MaxConcurrentStreams 69 | 70 | -- | Maximum message length in bytes that the channel can receive. -1 means 71 | -- unlimited. 72 | maxReceiveMessageLength :: ArgInt -> ChannelArgs 73 | maxReceiveMessageLength = argI grpcArg_MaxReceiveMessageLength 74 | 75 | -- | Maximum message length in bytes that the channel can send. -1 means 76 | -- unlimited. 77 | maxSendMessageLength :: ArgInt -> ChannelArgs 78 | maxSendMessageLength = argI grpcArg_MaxSendMessageLength 79 | 80 | -- | Initial sequence number for http2 transports. 81 | http2InitialSequenceNumber :: ArgInt -> ChannelArgs 82 | http2InitialSequenceNumber = argI grpcArg_Http2InitialSequenceNumber 83 | 84 | -- | Amount of bytes to read ahead on individual streams. Defaults to 64kb, 85 | -- larger values can help throughput on high-latency connections. NOTE: at 86 | -- some point we'd like to auto-tune this, and this parameter will become a 87 | -- no-op. 88 | http2StreamLookaheadBytes :: ArgInt -> ChannelArgs 89 | http2StreamLookaheadBytes = argI grpcArg_Http2StreamLookaheadBytes 90 | 91 | -- | How much memory (in bytes) to use for hpack decoding. 92 | http2HpackTableSizeDecoder :: ArgInt -> ChannelArgs 93 | http2HpackTableSizeDecoder = argI grpcArg_Http2HpackTableSizeDecoder 94 | 95 | -- | How much memory (in bytes) to use for hpack encoding. 96 | http2HpackTableSizeEncoder :: ArgInt -> ChannelArgs 97 | http2HpackTableSizeEncoder = argI grpcArg_Http2HpackTableSizeEncoder 98 | 99 | -- | How big a frame are we willing to receive via HTTP2. Min 16384, max 100 | -- 16777215. Larger values give lower CPU usage for large messages, but more 101 | -- head of line blocking for small messages. 102 | http2MaxFrameSize :: ArgInt -> ChannelArgs 103 | http2MaxFrameSize = argI grpcArg_Http2MaxFrameSize 104 | 105 | -- | Default authority to pass if none specified on call construction. 106 | defaultAuthority :: B.ByteString -> ChannelArgs 107 | defaultAuthority = argS grpcArg_DefaultAuthority 108 | 109 | -- | Primary user agent: goes at the start of the user-agent metadata sent on 110 | -- each request. 111 | primaryUserAgentString :: B.ByteString -> ChannelArgs 112 | primaryUserAgentString = argS grpcArg_PrimaryUserAgentString 113 | 114 | -- | Primary user agent: goes at the end of the user-agent metadata sent on 115 | -- each request. 116 | secondaryUserAgentString :: B.ByteString -> ChannelArgs 117 | secondaryUserAgentString = argS grpcArg_SecondaryUserAgentString 118 | 119 | -- | The maximum time between subsequent connection attempts, in ms. 120 | maxReconnectBackoffMs :: ArgInt -> ChannelArgs 121 | maxReconnectBackoffMs = argI grpcArg_MaxReconnectBackoffMs 122 | 123 | -- | The time between the first and second connection attempts, in ms. 124 | initialReconnectBackoffMs :: ArgInt -> ChannelArgs 125 | initialReconnectBackoffMs = argI grpcArg_InitialReconnectBackoffMs 126 | 127 | -- | The caller of the 'secure_channel_create' functions may override the 128 | -- target name used for SSL host name checking using this channel argument. 129 | -- This should be used for testing only. If this argument is not 130 | -- specified, the name used for SSL host name checking will be the target 131 | -- parameter (assuming that the secure channel is an SSL channel). If this 132 | -- parameter is specified and the underlying is not an SSL channel, it will 133 | -- just be ignored. 134 | sslTargetNameOverrideArg :: B.ByteString -> ChannelArgs 135 | sslTargetNameOverrideArg = argS grpcArg_SslTargetNameOverrideArg 136 | 137 | -- | Maximum metadata size, in bytes. 138 | maxMetadataSize :: ArgInt -> ChannelArgs 139 | maxMetadataSize = argI grpcArg_MaxMetadataSize 140 | 141 | -- | Allow the use of SO_REUSEPORT if it's available (default allow). 142 | allowReusePort :: ChannelArgs 143 | allowReusePort = argB grpcArg_AllowReuseport True 144 | 145 | -- | Disable the use of SO_REUSEPORT (default allow if available). 146 | disableReusePort :: ChannelArgs 147 | disableReusePort = argB grpcArg_AllowReuseport False 148 | 149 | arg :: B.ByteString -> ArgValue -> ChannelArgs 150 | arg s v = ChannelArgs (Map.singleton s v) 151 | 152 | argB :: B.ByteString -> Bool -> ChannelArgs 153 | argB s = arg s . ArgI . (\x -> if x then 1 else 0) 154 | 155 | argI :: B.ByteString -> ArgInt -> ChannelArgs 156 | argI s = arg s . ArgI 157 | 158 | argS :: B.ByteString -> B.ByteString -> ChannelArgs 159 | argS s = arg s . ArgS 160 | -------------------------------------------------------------------------------- /src/Network/Grpc/Lib/ChannelArgsStrings.hsc: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | {-# LANGUAGE OverloadedStrings #-} 16 | module Network.Grpc.Lib.ChannelArgsStrings where 17 | 18 | import qualified Data.ByteString as B 19 | 20 | #include "grpc/grpc.h" 21 | 22 | grpcArg_EnableSensus :: B.ByteString 23 | grpcArg_EnableSensus = (#const_str GRPC_ARG_ENABLE_CENSUS) 24 | 25 | grpcArg_EnableLoadReporting :: B.ByteString 26 | grpcArg_EnableLoadReporting = (#const_str GRPC_ARG_ENABLE_LOAD_REPORTING) 27 | 28 | grpcArg_MaxConcurrentStreams :: B.ByteString 29 | grpcArg_MaxConcurrentStreams = (#const_str GRPC_ARG_MAX_CONCURRENT_STREAMS) 30 | 31 | grpcArg_MaxReceiveMessageLength :: B.ByteString 32 | grpcArg_MaxReceiveMessageLength = (#const_str GRPC_ARG_MAX_RECEIVE_MESSAGE_LENGTH) 33 | 34 | grpcArg_MaxSendMessageLength :: B.ByteString 35 | grpcArg_MaxSendMessageLength = (#const_str GRPC_ARG_MAX_SEND_MESSAGE_LENGTH) 36 | 37 | grpcArg_Http2InitialSequenceNumber :: B.ByteString 38 | grpcArg_Http2InitialSequenceNumber = (#const_str GRPC_ARG_HTTP2_INITIAL_SEQUENCE_NUMBER) 39 | 40 | grpcArg_Http2StreamLookaheadBytes :: B.ByteString 41 | grpcArg_Http2StreamLookaheadBytes = (#const_str GRPC_ARG_HTTP2_STREAM_LOOKAHEAD_BYTES) 42 | 43 | grpcArg_Http2HpackTableSizeDecoder :: B.ByteString 44 | grpcArg_Http2HpackTableSizeDecoder = (#const_str GRPC_ARG_HTTP2_HPACK_TABLE_SIZE_DECODER) 45 | 46 | grpcArg_Http2HpackTableSizeEncoder :: B.ByteString 47 | grpcArg_Http2HpackTableSizeEncoder = (#const_str GRPC_ARG_HTTP2_HPACK_TABLE_SIZE_ENCODER) 48 | 49 | grpcArg_Http2MaxFrameSize :: B.ByteString 50 | grpcArg_Http2MaxFrameSize = (#const_str GRPC_ARG_HTTP2_MAX_FRAME_SIZE) 51 | 52 | grpcArg_DefaultAuthority :: B.ByteString 53 | grpcArg_DefaultAuthority = (#const_str GRPC_ARG_DEFAULT_AUTHORITY) 54 | 55 | grpcArg_PrimaryUserAgentString :: B.ByteString 56 | grpcArg_PrimaryUserAgentString = (#const_str GRPC_ARG_PRIMARY_USER_AGENT_STRING) 57 | 58 | grpcArg_SecondaryUserAgentString :: B.ByteString 59 | grpcArg_SecondaryUserAgentString = (#const_str GRPC_ARG_SECONDARY_USER_AGENT_STRING) 60 | 61 | grpcArg_MaxReconnectBackoffMs :: B.ByteString 62 | grpcArg_MaxReconnectBackoffMs = (#const_str GRPC_ARG_MAX_RECONNECT_BACKOFF_MS) 63 | 64 | grpcArg_InitialReconnectBackoffMs :: B.ByteString 65 | grpcArg_InitialReconnectBackoffMs = (#const_str GRPC_ARG_INITIAL_RECONNECT_BACKOFF_MS) 66 | 67 | grpcArg_SslTargetNameOverrideArg :: B.ByteString 68 | grpcArg_SslTargetNameOverrideArg = (#const_str GRPC_SSL_TARGET_NAME_OVERRIDE_ARG) 69 | 70 | grpcArg_MaxMetadataSize :: B.ByteString 71 | grpcArg_MaxMetadataSize = (#const_str GRPC_ARG_MAX_METADATA_SIZE) 72 | 73 | grpcArg_AllowReuseport :: B.ByteString 74 | grpcArg_AllowReuseport = (#const_str GRPC_ARG_ALLOW_REUSEPORT) 75 | 76 | grpcArg_ResourceQuota :: B.ByteString 77 | grpcArg_ResourceQuota = (#const_str GRPC_ARG_RESOURCE_QUOTA) 78 | 79 | grpcArg_ServiceConfig :: B.ByteString 80 | grpcArg_ServiceConfig = (#const_str GRPC_ARG_SERVICE_CONFIG) 81 | 82 | grpcArg_LbPolicyName :: B.ByteString 83 | grpcArg_LbPolicyName = (#const_str GRPC_ARG_LB_POLICY_NAME) 84 | -------------------------------------------------------------------------------- /src/Network/Grpc/Lib/Core.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | {-# LANGUAGE ViewPatterns, OverloadedStrings #-} 16 | 17 | module Network.Grpc.Lib.Core where 18 | 19 | #include 20 | #include 21 | #include "hs_grpc.h" 22 | 23 | import Data.List(genericLength) 24 | import Data.Monoid ((<>)) 25 | import Foreign.C.Types 26 | import Foreign.Marshal.Utils 27 | import Foreign.Marshal.Alloc 28 | import Foreign.Storable 29 | import Foreign.Ptr (Ptr, nullPtr, castPtr, plusPtr) 30 | 31 | import qualified Data.ByteString as B 32 | import qualified Data.ByteString.Char8 as C8 33 | import Data.ByteString (ByteString, useAsCString) 34 | import Data.ByteString.Unsafe (unsafePackCString) 35 | 36 | import System.IO.Unsafe (unsafeDupablePerformIO) 37 | 38 | import qualified Data.HashMap.Strict as Map 39 | 40 | import Network.Grpc.Lib.PropagationBits 41 | {#import Network.Grpc.Lib.TimeSpec#} 42 | {#import Network.Grpc.Lib.ByteBuffer#} 43 | 44 | {#context lib = "grpc" prefix = "grpc"#} 45 | 46 | -- grpc_shutdown may block for a long time, should not be marked with unsafe 47 | {#fun unsafe grpc_init as ^ {} -> `()'#} 48 | 49 | {#fun grpc_shutdown as ^ {} -> `()'#} 50 | 51 | 52 | type SizeT = {#type size_t#} 53 | 54 | -- -------------------- 55 | -- Channel Arguments 56 | -- -------------------- 57 | 58 | data ChannelArgs = ChannelArgs { unChannelArgs :: Map.HashMap B.ByteString ArgValue } 59 | 60 | toList :: ChannelArgs -> [(B.ByteString, ArgValue)] 61 | toList = Map.toList . unChannelArgs 62 | 63 | instance Monoid ChannelArgs where 64 | mempty = ChannelArgs mempty 65 | mappend (ChannelArgs a) (ChannelArgs b) = ChannelArgs (Map.union b a) 66 | 67 | data CChannelArgs 68 | {#pointer *channel_args as GrpcChannelArgs -> CChannelArgs#} 69 | 70 | type ArgInt = CInt 71 | 72 | data ArgValue 73 | = ArgI ArgInt 74 | | ArgS B.ByteString deriving Show 75 | 76 | data CArg 77 | {#pointer *arg as GrpcArg -> CArg#} 78 | 79 | {#enum arg_type as GrpcArgType {underscoreToCase}#} 80 | 81 | withChannelArgs :: ChannelArgs -> (GrpcChannelArgs -> IO a) -> IO a 82 | withChannelArgs (toList -> []) act = act nullPtr 83 | withChannelArgs (toList -> args) act = 84 | allocaBytes {#sizeof grpc_channel_args#} $ \root -> do 85 | {#set grpc_channel_args->num_args#} root (genericLength args) 86 | allocaBytes ({#sizeof grpc_arg#} * length args) $ \arr -> do 87 | {#set grpc_channel_args->args#} root arr 88 | let 89 | write [] _ = act root 90 | write ((key, value):xs) elemPtr = do 91 | print (key, value) 92 | let 93 | cont = write xs (elemPtr `plusPtr` {#sizeof grpc_arg#}) 94 | B.useAsCString key $ \keyPtr -> do 95 | {#set grpc_arg->key#} elemPtr keyPtr 96 | case value of 97 | ArgI i -> do 98 | {#set grpc_arg->type#} elemPtr (fromIntegral (fromEnum ArgInteger)) 99 | {#set grpc_arg->value.integer#} elemPtr i 100 | cont 101 | ArgS s -> do 102 | {#set grpc_arg->type#} elemPtr (fromIntegral (fromEnum ArgString)) 103 | B.useAsCString s $ \valuePtr -> do 104 | {#set grpc_arg->value.string#} elemPtr valuePtr 105 | cont 106 | write args arr 107 | 108 | -- -------------------- 109 | -- Channel 110 | -- -------------------- 111 | 112 | data CChannel 113 | {#pointer *grpc_channel as GrpcChannel foreign -> CChannel#} 114 | 115 | {#fun unsafe grpc_insecure_channel_create as ^ 116 | { useAsCString* `ByteString', 117 | withChannelArgs* `ChannelArgs', 118 | id `Ptr ()' } -> `GrpcChannel'#} 119 | 120 | data Channel = Channel 121 | { cChannel :: !GrpcChannel 122 | , cHost :: !Slice 123 | } 124 | 125 | createInsecureChannel :: B.ByteString -> Int -> ChannelArgs -> IO Channel 126 | createInsecureChannel host port args = do 127 | chan <- grpcInsecureChannelCreate hostPort args nullPtr 128 | hostSlice <- sliceFromCopy host 129 | return $! Channel chan hostSlice 130 | where 131 | hostPort = host <> ":" <> (C8.pack (show port)) 132 | 133 | {#fun unsafe grpc_channel_destroy as ^ 134 | { `GrpcChannel' } -> `()'#} 135 | 136 | destroyChannel :: Channel -> IO () 137 | destroyChannel chan = 138 | grpcChannelDestroy (cChannel chan) 139 | 140 | -- --------------------------- 141 | -- Completion Queue and events 142 | -- --------------------------- 143 | 144 | data CCompletionQueue 145 | {#pointer *completion_queue as CompletionQueue -> CCompletionQueue#} 146 | 147 | data Event 148 | = QueueTimeOut 149 | | QueueShutdown 150 | | QueueOpComplete !OpStatus !Tag 151 | deriving Show 152 | {#pointer *grpc_event as EventPtr -> Event#} 153 | 154 | {#enum completion_type as ^ {underscoreToCase} add prefix = "Enum" deriving (Show,Eq)#} 155 | 156 | {#fun unsafe completion_queue_create_for_next as ^ 157 | { `Ptr ()' } -> `CompletionQueue'#} 158 | 159 | -- Must be marked with safe (not unsafe) as it may block. 160 | {#fun hs_grpc_completion_queue_next as grpcCompletionQueueNext 161 | { `CompletionQueue', 162 | with* `TimeSpec', 163 | alloca- `Event' peek* } -> `()' #} 164 | 165 | -- Must be marked with safe (not unsafe) as it may block. 166 | {#fun hs_grpc_completion_queue_pluck as grpcCompletionQueuePluck 167 | { `CompletionQueue', 168 | `Ptr ()', 169 | with* `TimeSpec', 170 | alloca- `Event' peek* } -> `()' #} 171 | 172 | {#fun unsafe completion_queue_destroy as ^ 173 | {`CompletionQueue'} -> `()'#} 174 | 175 | {#fun unsafe completion_queue_shutdown as ^ 176 | {`CompletionQueue'} -> `()'#} 177 | 178 | instance Storable Event where 179 | sizeOf _ = {#sizeof grpc_event#} 180 | alignment _ = {#alignof grpc_event#} 181 | peek p 182 | | p == nullPtr = return QueueTimeOut 183 | | otherwise = do 184 | typ <- fmap (toEnum . fromIntegral) $ {#get grpc_event->type#} p 185 | case typ of 186 | EnumQueueShutdown -> do 187 | return QueueShutdown 188 | EnumQueueTimeout -> do 189 | return QueueTimeOut 190 | EnumOpComplete -> do 191 | success <- {#get grpc_event->success#} p 192 | tag <- {#get grpc_event->tag#} p 193 | return $! QueueOpComplete (toOpStatus success) tag 194 | poke _ _ = error "Storable.Event.poke: Must not call poke on an event" 195 | 196 | type Tag = Ptr () 197 | type StatusCodeT = {#type status_code#} 198 | 199 | toOpStatus :: CInt -> OpStatus 200 | toOpStatus 0 = OpError -- non-zero for failure! 201 | toOpStatus _ = OpSuccess 202 | 203 | fromOpStatus :: OpStatus -> CInt 204 | fromOpStatus OpError = 0 205 | fromOpStatus _ = 1 206 | 207 | {#enum grpc_op_type as OpType {underscoreToCase} deriving (Eq, Show)#} 208 | 209 | data OpStatus 210 | = OpError 211 | | OpSuccess 212 | deriving (Enum, Show) 213 | 214 | data GrpcOp 215 | {#pointer *grpc_op as GrpcOpPtr -> GrpcOp #} 216 | 217 | mkTag :: Int -> Ptr () 218 | mkTag n = castPtr (nullPtr `plusPtr` n) 219 | 220 | -- -------------------- 221 | -- Call 222 | -- -------------------- 223 | 224 | data CCall 225 | {#pointer *grpc_call as Call -> CCall#} 226 | 227 | {#enum status_code as ^ {underscoreToCase} deriving (Show,Eq)#} 228 | {#enum call_error as ^ {underscoreToCase} deriving (Eq, Show)#} 229 | 230 | toStatusCode :: CInt -> StatusCode 231 | toStatusCode = toEnum . fromIntegral 232 | 233 | fromStatusCode :: StatusCode -> CInt 234 | fromStatusCode = fromIntegral . fromEnum 235 | 236 | toCallError :: CInt -> CallError 237 | toCallError = toEnum . fromIntegral 238 | 239 | fromCallError :: CallError -> CInt 240 | fromCallError = fromIntegral . fromEnum 241 | 242 | {#fun unsafe hs_grpc_channel_create_call as grpcChannelCreateCall 243 | { `GrpcChannel', 244 | id `Ptr CCall', 245 | fromIntegral `PropagationMask', 246 | `CompletionQueue', 247 | `Slice', 248 | `Slice', 249 | with* `TimeSpec' } -> `Call' #} 250 | 251 | {#fun unsafe grpc_call_unref as ^ 252 | {`Call'} -> `()'#} 253 | 254 | {#fun unsafe grpc_call_start_batch as ^ 255 | {`Call', `GrpcOpPtr', `CULong', `Ptr ()', `Ptr ()'} -> `CallError' toCallError#} 256 | 257 | {#fun unsafe grpc_call_cancel as grpcCallCancel 258 | { `Call', 259 | id `Ptr ()' } -> `CallError' #} 260 | 261 | {#fun unsafe grpc_call_cancel_with_status as grpcCallCancelWithStatus 262 | { `Call' 263 | , `StatusCode' 264 | , useAsCString* `ByteString' 265 | , id `Ptr ()' } -> `CallError' #} 266 | 267 | 268 | -- -------------------- 269 | -- Compression 270 | -- -------------------- 271 | 272 | -- |To be used as initial metadata key for the request of a concrete 273 | -- compression algorithm. 274 | compressionRequestAlgorithmMdKey :: ByteString 275 | compressionRequestAlgorithmMdKey = 276 | {#const GRPC_COMPRESSION_REQUEST_ALGORITHM_MD_KEY#} 277 | 278 | {#enum compression_algorithm as CompressionAlgorithm {underscoreToCase} 279 | omit (GRPC_COMPRESS_ALGORITHMS_COUNT) #} 280 | 281 | {#enum compression_level as CompressionLevel {underscoreToCase} 282 | omit (GRPC_COMPRESS_LEVEL_COUNT) #} 283 | 284 | -- | Updates \a name with the encoding name corresponding to a valid \a 285 | -- algorithm. Note that \a name is statically allocated and must *not* be freed. 286 | -- Returns 1 upon success, 0 otherwise. */ 287 | {#fun unsafe grpc_compression_algorithm_name as compressionAlgorithmName_ 288 | {`CompressionAlgorithm' 289 | , id `Ptr (Ptr CChar)' 290 | } -> `Bool' #} 291 | 292 | -- | Returns the encoding name for the given algorithm. 293 | compressionAlgorithmName :: CompressionAlgorithm -> ByteString 294 | compressionAlgorithmName algo = unsafeDupablePerformIO $ 295 | alloca $ \ptrPtr -> do 296 | res <- compressionAlgorithmName_ algo ptrPtr 297 | if res 298 | then do 299 | ptr <- peek ptrPtr 300 | unsafePackCString ptr 301 | else error "compressionAlgorithmName: no name for algorithm" 302 | -------------------------------------------------------------------------------- /src/Network/Grpc/Lib/Metadata.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | module Network.Grpc.Lib.Metadata ( 16 | Metadata(..) 17 | , MetadataPtr 18 | , mallocMetadata 19 | 20 | , isKeyValid 21 | , isNonBinValueValid 22 | , isBinaryHeader 23 | 24 | , MetadataArray 25 | , mallocMetadataArray 26 | , readMetadataArray 27 | , freeMetadataArray 28 | ) where 29 | 30 | #include 31 | #include "hs_grpc.h" 32 | 33 | import qualified Foreign.Ptr as C 34 | import Foreign.Ptr (Ptr) 35 | import qualified Foreign.ForeignPtr as C 36 | import qualified Foreign.Marshal.Alloc as C 37 | import qualified Foreign.Marshal.Array as C 38 | import qualified Foreign.Storable as C 39 | 40 | import Control.Monad 41 | 42 | import Data.ByteString (ByteString) 43 | {#import Network.Grpc.Lib.ByteBuffer#} (Slice, CSlice, toByteString, grpcSliceFromCopiedBuffer) 44 | 45 | {#context lib = "grpc" prefix = "grpc" #} 46 | 47 | {#pointer *grpc_metadata as MetadataPtr -> Metadata#} 48 | 49 | data Metadata = Metadata !ByteString !ByteString !{#type uint32_t#} deriving (Show) 50 | 51 | instance Eq Metadata where 52 | (Metadata a b _) == (Metadata x y _) = (a,b) == (x,y) 53 | 54 | -- | Cast the pointer due to c2hs not resolving the type properly, 55 | -- or not supporting our use case. 56 | wonkyC2hsCast :: C.Ptr a -> C.Ptr b 57 | wonkyC2hsCast = C.castPtr 58 | 59 | metadataKey :: Ptr Metadata -> IO Slice 60 | metadataKey p = do 61 | C.newForeignPtr_ (wonkyC2hsCast (p `C.plusPtr` {#offsetof grpc_metadata.key#})) 62 | 63 | metadataValue :: Ptr Metadata -> IO Slice 64 | metadataValue p = do 65 | C.newForeignPtr_ (wonkyC2hsCast (p `C.plusPtr` {#offsetof grpc_metadata.value#})) 66 | 67 | instance C.Storable Metadata where 68 | sizeOf _ = {#sizeof grpc_metadata#} 69 | alignment _ = {#alignof grpc_metadata#} 70 | peek p = do 71 | keySlice <- metadataKey p 72 | key <- toByteString keySlice 73 | valueSlice <- metadataValue p 74 | value <- toByteString valueSlice 75 | flags <- {#get grpc_metadata.flags#} p 76 | return $! Metadata key value flags 77 | poke _ _ = error "Storable Metadata: poke not implemented" 78 | 79 | data CMetadataArray 80 | {#pointer *metadata_array as MetadataArray -> CMetadataArray#} 81 | 82 | {#fun unsafe metadata_array_init as ^ 83 | {`MetadataArray'} -> `()'#} 84 | 85 | {#fun unsafe metadata_array_destroy as ^ 86 | {`MetadataArray'} -> `()'#} 87 | 88 | mallocMetadata :: [Metadata] -> IO (MetadataPtr, IO ()) 89 | mallocMetadata mds = do 90 | arr <- C.mallocBytes (length mds * {#sizeof grpc_metadata#}) 91 | forM_ (zip [0..] mds) $ \(i, md) -> 92 | writeMetadata md (arr `C.plusPtr` (i * {#sizeof grpc_metadata#})) 93 | return (C.castPtr arr, C.free arr) 94 | where 95 | writeMetadata (Metadata key value flags) arr_ptr = do 96 | keyPtr <- C.newForeignPtr_ (arr_ptr `C.plusPtr` {#offsetof grpc_metadata.key#}) 97 | valuePtr <- C.newForeignPtr_ (arr_ptr `C.plusPtr` {#offsetof grpc_metadata.value#}) 98 | grpcSliceFromCopiedBuffer key keyPtr 99 | grpcSliceFromCopiedBuffer value valuePtr 100 | {#set grpc_metadata.flags#} arr_ptr flags 101 | 102 | mallocMetadataArray :: IO (C.Ptr CMetadataArray) 103 | mallocMetadataArray = do 104 | ptr <- C.mallocBytes {#sizeof grpc_metadata_array#} 105 | metadataArrayInit ptr 106 | return ptr 107 | 108 | freeMetadataArray :: MetadataArray -> IO () 109 | freeMetadataArray arr = do 110 | metadataArrayDestroy arr 111 | C.free arr 112 | 113 | readMetadataArray :: MetadataArray -> IO [Metadata] 114 | readMetadataArray arr = do 115 | count <- {#get grpc_metadata_array->count#} arr 116 | metadataPtr <- {#get grpc_metadata_array->metadata#} arr 117 | C.peekArray (fromIntegral count) metadataPtr 118 | 119 | -- | Validate the key of a metadata pair. 120 | {#fun pure grpc_header_key_is_legal as isKeyValid 121 | { %`Slice' } -> `Bool' #} 122 | 123 | -- | Validate a non-binary value. 124 | {#fun pure grpc_header_nonbin_value_is_legal as isNonBinValueValid 125 | { %`Slice' } -> `Bool' #} 126 | 127 | -- | Is the key a binary key? 128 | {#fun pure grpc_is_binary_header as isBinaryHeader 129 | { %`Slice' } -> `Bool' #} -------------------------------------------------------------------------------- /src/Network/Grpc/Lib/PropagationBits.hsc: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | module Network.Grpc.Lib.PropagationBits where 16 | 17 | import Data.Word(Word32) 18 | 19 | #include "grpc/grpc.h" 20 | 21 | type PropagationBit = (#type uint32_t) 22 | type PropagationMask = (#type uint32_t) 23 | 24 | propagateDefaults :: PropagationMask 25 | propagateDefaults = (#const GRPC_PROPAGATE_DEFAULTS) 26 | 27 | -- | Propagate deadline. 28 | propagateDeadline :: PropagationBit 29 | propagateDeadline = (#const GRPC_PROPAGATE_DEADLINE) 30 | 31 | -- | Propagate census context. 32 | propagateCensusStatsContext :: PropagationBit 33 | propagateCensusStatsContext = (#const GRPC_PROPAGATE_CENSUS_STATS_CONTEXT) 34 | 35 | -- | Propagate census context. 36 | propagateCensusTracingContext :: PropagationBit 37 | propagateCensusTracingContext = (#const GRPC_PROPAGATE_CENSUS_TRACING_CONTEXT) 38 | 39 | -- | Propagate cancellation. 40 | propagateCancellation :: PropagationBit 41 | propagateCancellation = (#const GRPC_PROPAGATE_CANCELLATION) 42 | 43 | -------------------------------------------------------------------------------- /src/Network/Grpc/Lib/TimeSpec.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | module Network.Grpc.Lib.TimeSpec where 16 | 17 | import Data.Int 18 | import Foreign.Storable 19 | import Foreign.Marshal.Alloc 20 | import Foreign.Marshal.Utils 21 | 22 | import System.IO.Unsafe (unsafePerformIO) 23 | 24 | #include 25 | #include "hs_grpc.h" 26 | #include "hs_time.h" 27 | 28 | {#pointer *gpr_timespec as TimeSpecPtr -> TimeSpec #} 29 | 30 | data TimeSpec = TimeSpec {#type int64_t#} {#type int32_t#} {#type gpr_clock_type#} deriving Show 31 | 32 | instance Storable TimeSpec where 33 | sizeOf _ = {#sizeof gpr_timespec#} 34 | alignment _ = {#alignof gpr_timespec#} 35 | peek p = do 36 | tv_sec <- {#get gpr_timespec->tv_sec#} p 37 | tv_nsec <- {#get gpr_timespec->tv_nsec#} p 38 | clock_type <- {#get gpr_timespec->clock_type#} p 39 | return $! TimeSpec tv_sec tv_nsec clock_type 40 | poke p (TimeSpec tv_sec tv_nsec clock_type) = do 41 | {#set gpr_timespec->tv_sec#} p tv_sec 42 | {#set gpr_timespec->tv_nsec#} p tv_nsec 43 | {#set gpr_timespec->clock_type#} p clock_type 44 | 45 | {#fun unsafe hs_gpr_now as gprNow 46 | { alloca- `TimeSpec' peek* } -> `()' #} 47 | 48 | {#fun pure unsafe hs_gpr_time_from_seconds as ^ 49 | { `Int64' 50 | , alloca- `TimeSpec'} -> `TimeSpec' peek* #} 51 | 52 | {#fun pure unsafe hs_gpr_time_from_millis as ^ 53 | { `Int64' 54 | , alloca- `TimeSpec'} -> `TimeSpec' peek* #} 55 | 56 | {#fun pure unsafe hs_gpr_time_add as ^ 57 | { with* `TimeSpec' 58 | , with* `TimeSpec' 59 | , alloca- `TimeSpec'} -> `TimeSpec' peek* #} 60 | 61 | {#fun unsafe hs_gpr_inf_future as ^ 62 | { alloca- `TimeSpec' peek* } -> `()' #} 63 | 64 | secondsFromNow :: Int64 -> IO TimeSpec 65 | secondsFromNow n = do 66 | now <- gprNow 67 | return $! now `hsGprTimeAdd` (hsGprTimeFromSeconds n) 68 | 69 | millisFromNow :: Int64 -> IO TimeSpec 70 | millisFromNow n = do 71 | now <- gprNow 72 | return $! now `hsGprTimeAdd` (hsGprTimeFromMillis n) 73 | 74 | gprInfFuture :: TimeSpec 75 | gprInfFuture = unsafePerformIO hsGprInfFuture 76 | -------------------------------------------------------------------------------- /src/Network/Grpc/Lib/Version.chs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | module Network.Grpc.Lib.Version where 16 | 17 | import Data.ByteString 18 | import Data.ByteString.Unsafe 19 | 20 | 21 | #include 22 | 23 | {#fun pure unsafe grpc_version_string as version 24 | {} -> `ByteString' unsafePackCString* #} 25 | -------------------------------------------------------------------------------- /tests/interop_client/main.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2017 gRPC authors. 2 | -- 3 | -- Licensed under the Apache License, Version 2.0 (the "License"); 4 | -- you may not use this file except in compliance with the License. 5 | -- You may obtain a copy of the License at 6 | -- 7 | -- http://www.apache.org/licenses/LICENSE-2.0 8 | -- 9 | -- Unless required by applicable law or agreed to in writing, software 10 | -- distributed under the License is distributed on an "AS IS" BASIS, 11 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | -- See the License for the specific language governing permissions and 13 | -- limitations under the License. 14 | -------------------------------------------------------------------------------- 15 | {-# LANGUAGE OverloadedStrings #-} 16 | module Main where 17 | 18 | import Control.Exception 19 | import Control.Monad 20 | import Control.Monad.IO.Class (liftIO) 21 | import Control.Concurrent (threadDelay) 22 | import Data.Monoid ((<>)) 23 | import Data.Either (either) 24 | import System.Console.GetOpt 25 | import System.Environment 26 | import System.Exit 27 | import System.Mem 28 | 29 | import Control.Monad.Trans.Except 30 | 31 | import qualified Data.ByteString as B 32 | import qualified Data.ByteString.Char8 as C8 33 | import qualified Data.ByteString.Lazy as L 34 | 35 | import Network.Grpc.Core.Call 36 | import Network.Grpc.Lib.Core 37 | import Network.Grpc.Lib.Metadata 38 | 39 | import Data.Default.Class (def) 40 | import Data.ProtoLens (decodeMessage, 41 | encodeMessage) 42 | import Proto.Src.Proto.Grpc.Testing.Messages (Payload (..), 43 | ResponseParameters (..), 44 | SimpleRequest (..), 45 | SimpleResponse (..), 46 | StreamingOutputCallRequest (..), 47 | StreamingInputCallRequest (..), 48 | StreamingInputCallResponse (..), 49 | StreamingOutputCallResponse (..), 50 | EchoStatus (..)) 51 | 52 | data Options = Options 53 | { optServerHost :: String 54 | , optServerHostOverride :: String 55 | , optServerPort :: Int 56 | , optTestCase :: TestCaseFlag 57 | , optUseTLS :: Bool 58 | , optUseTestCA :: Bool 59 | , optDefaultServiceAccount :: String 60 | , optOAuthScope :: String 61 | , optServiceAccountKeyFile :: FilePath 62 | } 63 | 64 | data TestCaseFlag 65 | = TestCase TestCase 66 | | AllTests 67 | | TestCaseUnknown String 68 | 69 | data TestCase 70 | = CancelAfterBegin 71 | | ClientStreaming 72 | | ServerStreaming 73 | | ServerStreamingWithSlowConsumer 74 | | CustomMetadata 75 | | EmptyStream 76 | | EmptyUnary 77 | | LargeUnary 78 | | PingPong 79 | | StatusCodeAndMessage 80 | | TimeoutOnSleepingServer 81 | | UnimplementedMethod 82 | | UnimplementedService 83 | deriving (Bounded, Enum, Show) 84 | 85 | defaultOptions :: Options 86 | defaultOptions = Options 87 | { optServerHost = "localhost" 88 | , optServerHostOverride = "" 89 | , optServerPort = 0 90 | , optTestCase = TestCaseUnknown "not specified" 91 | , optUseTLS = False 92 | , optUseTestCA = False 93 | , optDefaultServiceAccount = "" 94 | , optOAuthScope = "" 95 | , optServiceAccountKeyFile = "" 96 | } 97 | 98 | stringToBool :: String -> Bool 99 | stringToBool "true" = True 100 | stringToBool "TRUE" = True 101 | stringToBool _ = False 102 | 103 | testCaseMap :: [(String, (Bool, TestCase))] 104 | testCaseMap = 105 | [ ("cancel_after_begin" , (True, CancelAfterBegin)) 106 | , ("client_streaming" , (True, ClientStreaming)) 107 | , ("server_streaming" , (True, ServerStreaming)) 108 | , ("slow_consumer" , (False, ServerStreamingWithSlowConsumer)) 109 | , ("custom_metadata" , (True, CustomMetadata)) 110 | , ("empty_stream" , (True, EmptyStream)) 111 | , ("empty_unary" , (True, EmptyUnary)) 112 | , ("large_unary" , (True, LargeUnary)) 113 | , ("ping_pong" , (True, PingPong)) 114 | , ("status_code_and_message" , (True, StatusCodeAndMessage)) 115 | , ("timeout_on_sleeping_server", (True, TimeoutOnSleepingServer)) 116 | , ("unimplemented_method" , (True, UnimplementedMethod)) 117 | , ("unimplemented_service" , (True, UnimplementedService)) 118 | ] 119 | 120 | allTests :: [TestCase] 121 | allTests = [ tc | (_, (True, tc)) <- testCaseMap ] 122 | 123 | renderTestCases :: String 124 | renderTestCases = unlines (map (" - " ++ ) ("all":map fst testCaseMap)) 125 | 126 | testCase :: String -> TestCaseFlag 127 | testCase "all" = AllTests 128 | testCase str 129 | | Just (_, tc) <- lookup str testCaseMap = TestCase tc 130 | testCase unknown = TestCaseUnknown unknown 131 | 132 | options :: [OptDescr (Options -> Options)] 133 | options = 134 | [ Option [] ["server_host"] 135 | (ReqArg (\host opts -> opts { optServerHost = host }) "HOSTNAME") 136 | "The server host to connect to. Default is \"localhost\"" 137 | , Option [] ["server_host_override"] 138 | (ReqArg (\host opts -> opts { optServerHostOverride = host}) "HOSTNAME") 139 | ("The server host to claim to be connecting to, for use in TLS and HTTP/2 :authority header.\n" 140 | ++ "If unspecified, the value of --server_host will be used") 141 | , Option [] ["server_port"] 142 | (ReqArg (\port opts -> opts { optServerPort = read port }) "PORT") 143 | "The server port to connect to. For example, \"8080\"" 144 | , Option [] ["test_case"] 145 | (ReqArg (\test opts -> opts { optTestCase = testCase test }) "TESTCASE") 146 | ("The name of the test case to execute. Test cases;\n" ++ renderTestCases) 147 | , Option [] ["use_tls"] 148 | (ReqArg (\tls opts -> opts { optUseTLS = stringToBool tls }) "BOOLEAN") 149 | "Whether to use a plaintext or encrypted connection" 150 | , Option [] ["use_test_ca"] 151 | (ReqArg (\test_ca opts -> opts { optUseTestCA = stringToBool test_ca }) "BOOLEAN") 152 | "Whether to replace platform root CAs with ca.pem as the CA root" 153 | , Option [] ["default_service_account"] 154 | (ReqArg (\acc opts -> opts { optDefaultServiceAccount = acc }) "ACCOUNT_EMAIL") 155 | "Email of the GCE default service account." 156 | , Option [] ["oauth_scope"] 157 | (ReqArg (\scope opts -> opts { optOAuthScope = scope }) "SCOPE") 158 | "OAuth scope. For example, \"https://www.googleapis.com/auth/xapi.zoo\"" 159 | , Option [] ["service_account_key_file"] 160 | (ReqArg (\file opts -> opts { optServiceAccountKeyFile = file }) "PATH") 161 | ("The path to the service account JSON key file generated from GCE developer console.\n" 162 | ++ "Clients must support TLS with ALPN. Clients must not disable certificate checking.") 163 | ] 164 | 165 | parseOptions :: [String] -> Either [String] Options 166 | parseOptions flags = 167 | case getOpt Permute options flags of 168 | (opts, [], []) -> 169 | let opts' = foldl (flip id) defaultOptions opts in 170 | case validateOptions opts' of 171 | [] -> Right opts' 172 | errs -> Left errs 173 | (_, unkn, err) -> Left (map ("unrecognized argument " ++) unkn ++ err) 174 | 175 | validateOptions :: Options -> [String] 176 | validateOptions opts = 177 | [ "Missing flag --server_host=HOSTNAME" | "" <- return (optServerHost opts) ] 178 | ++ [ "Missing flag --server_port=PORT" | 0 <- return (optServerPort opts) ] 179 | ++ [ "Missing flag --test_case=TESTCASE or invalid test case" | TestCaseUnknown _ <- return (optTestCase opts) ] 180 | 181 | callOptions :: CallOptions 182 | callOptions = withRelativeDeadlineSeconds 2 183 | 184 | main :: IO () 185 | main = do 186 | args <- getArgs 187 | opts <- case parseOptions args of 188 | Left errs -> do 189 | putStrLn "Errors while parsing flags:" 190 | mapM_ putStrLn errs 191 | putStrLn "" 192 | putStrLn (usageInfo "Usage: interop_client [OPTION]" options) 193 | exitFailure 194 | Right opts -> return opts 195 | ok <- case optTestCase opts of 196 | AllTests -> 197 | fmap and $ forM allTests $ \tc -> 198 | testWrapper tc (runTest tc opts) 199 | TestCaseUnknown tc -> do 200 | putStrLn ("Unknown or not specified test case: " ++ tc) 201 | return False 202 | TestCase tc -> 203 | testWrapper tc (runTest tc opts) 204 | unless ok exitFailure 205 | 206 | testWrapper :: TestCase -> IO (Either String ()) -> IO Bool 207 | testWrapper tc act = 208 | bracket_ 209 | grpcInit 210 | (performMajorGC >> grpcShutdown) 211 | (do 212 | result <- act 213 | case result of 214 | Right _ -> do 215 | putStrLn (show tc ++ ": ok") 216 | return True 217 | Left err -> do 218 | putStrLn (show tc ++ ": failed; " ++ err) 219 | return False) 220 | 221 | runTest :: TestCase -> Options -> IO (Either String ()) 222 | runTest CancelAfterBegin = runCancelAfterBeginTest 223 | runTest ClientStreaming = runClientStreamingTest 224 | runTest ServerStreaming = runServerStreamingTest 225 | runTest ServerStreamingWithSlowConsumer = runServerStreamingWithSlowConsumerTest 226 | runTest CustomMetadata = runCustomMetadataTest 227 | runTest EmptyStream = runEmptyStreamTest 228 | runTest EmptyUnary = runEmptyUnaryTest 229 | runTest LargeUnary = runLargeUnaryTest 230 | runTest PingPong = runPingPongTest 231 | runTest StatusCodeAndMessage = runStatusCodeAndMessageTest 232 | runTest TimeoutOnSleepingServer = runTimeoutOnSleepingServerTest 233 | runTest UnimplementedMethod = runUnimplementedMethodTest 234 | runTest UnimplementedService = runUnimplementedServiceTest 235 | 236 | newChannel :: Options -> IO Channel 237 | newChannel opts = 238 | createInsecureChannel (C8.pack (optServerHost opts)) (optServerPort opts) mempty 239 | 240 | seq_ :: [(String, IO (Either String ()))] -> IO (Either String ()) 241 | seq_ [] = return (Right ()) 242 | seq_ ((msg, x):xs) = do 243 | v <- x 244 | case v of 245 | Right _ -> seq_ xs 246 | Left desc -> return (Left (msg ++ ": " ++ desc)) 247 | 248 | mapLeft :: (a -> c) -> Either a b -> Either c b 249 | mapLeft left = either (Left . left) Right 250 | 251 | maybeToEither :: e -> Maybe a -> Either e a 252 | maybeToEither e Nothing = Left e 253 | maybeToEither _ (Just x) = Right x 254 | 255 | -- | This test verifies that implementations support zero-size messages. 256 | -- Ideally, client implementations would verify that the request and 257 | -- response were zero bytes serialized, but this is generally prohibitive to 258 | -- perform, so is not required. 259 | -- 260 | -- Server features: 261 | -- - EmptyCall 262 | -- Procedure: 263 | -- 1. Client calls EmptyCall with the default Empty message 264 | -- Client asserts: 265 | -- - call was successful 266 | -- - response is non-null 267 | -- 268 | -- It may be possible to use UnaryCall instead of EmptyCall, but it is harder 269 | -- to ensure that the proto serialized to zero bytes. 270 | runEmptyUnaryTest :: Options -> IO (Either String ()) 271 | runEmptyUnaryTest opts = 272 | bracket (newChannel opts) destroyChannel $ \channel -> 273 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 274 | resp <- callUnary ctx callOptions "/grpc.testing.TestService/EmptyCall" B.empty 275 | case resp of 276 | RpcOk (UnaryResult _ _ msg) 277 | | L.null msg -> return (Right ()) 278 | | otherwise -> return (Left "Non zero reply, failure.") 279 | RpcError err -> return (Left (show err)) 280 | 281 | -- | This test verifies unary calls succeed in sending messages, and touches 282 | -- on flow control (even if compression is enabled on the channel). 283 | -- Server features: 284 | -- - UnaryCall 285 | -- Procedure: 286 | -- 1. Client calls UnaryCall with: 287 | -- { 288 | -- response_size: 314159 289 | -- payload:{ 290 | -- body: 271828 bytes of zeros 291 | -- } 292 | -- } 293 | -- Client asserts: 294 | -- - call was successful 295 | -- - response payload body is 314159 bytes in size 296 | -- - clients are free to assert that the response payload body contents are 297 | -- zero and comparing the entire response message against a golden 298 | -- response. 299 | runLargeUnaryTest :: Options -> IO (Either String ()) 300 | runLargeUnaryTest opts = do 301 | let req = def { _SimpleRequest'responseSize = 314159 302 | , _SimpleRequest'payload = Just def { 303 | _Payload'body = B.replicate 271828 0 304 | } 305 | } 306 | bracket (newChannel opts) destroyChannel $ \channel -> 307 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 308 | resp <- callUnary ctx callOptions "/grpc.testing.TestService/UnaryCall" (encodeMessage req) 309 | case resp of 310 | RpcOk (UnaryResult _ _ resp') -> 311 | case decodeMessage (L.toStrict resp') of 312 | Left err -> return (Left ("proto decoder says: " ++ err)) 313 | Right msg -> 314 | case _SimpleResponse'payload msg of 315 | Nothing -> return (Left "no payload") 316 | Just payload -> 317 | case B.length (_Payload'body payload) of 318 | 314159 -> return (Right ()) 319 | n -> return (Left ("wrong payload: " ++ show n)) 320 | RpcError err -> return (Left (show err)) 321 | 322 | 323 | -- | This test verifies that custom metadata in either binary or ascii format can be 324 | -- sent as initial-metadata by the client and as both initial- and trailing-metadata 325 | -- by the server. 326 | -- Server features: 327 | -- - UnaryCall 328 | -- - FullDuplexCall 329 | -- - Echo Metadata 330 | -- Procedure: 331 | -- 1. The client attaches custom metadata with the following keys and values: 332 | -- ``` 333 | -- key: "x-grpc-test-echo-initial", value: "test_initial_metadata_value" 334 | -- key: "x-grpc-test-echo-trailing-bin", value: 0xababab 335 | -- ``` 336 | -- to a UnaryCall with request: 337 | -- ``` 338 | -- { 339 | -- response_size: 314159 340 | -- payload:{ 341 | -- body: 271828 bytes of zeros 342 | -- } 343 | -- } 344 | -- ``` 345 | -- 2. The client attaches custom metadata with the following keys and values: 346 | -- ``` 347 | -- key: "x-grpc-test-echo-initial", value: "test_initial_metadata_value" 348 | -- key: "x-grpc-test-echo-trailing-bin", value: 0xababab 349 | -- ``` 350 | -- to a FullDuplexCall with request: 351 | -- ``` 352 | -- { 353 | -- response_size: 314159 354 | -- payload:{ 355 | -- body: 271828 bytes of zeros 356 | -- } 357 | -- } 358 | -- ``` 359 | -- and then half-closes 360 | -- 361 | -- Client asserts: 362 | -- - call was successful 363 | -- - metadata with key `"x-grpc-test-echo-initial"` and value 364 | -- `"test_initial_metadata_value"`is received in the initial metadata for calls 365 | -- in Procedure steps 1 and 2. 366 | -- - metadata with key `"x-grpc-test-echo-trailing-bin"` and value `0xababab` is 367 | -- received in the trailing metadata for calls in Procedure steps 1 and 2. 368 | runCustomMetadataTest :: Options -> IO (Either String ()) 369 | runCustomMetadataTest opts = 370 | seq_ 371 | [ ("procedure1", procedure1) 372 | , ("procedure2", procedure2)] 373 | where 374 | expectedInitMd = Metadata "x-grpc-test-echo-initial" "test_initial_metadata_value" 0 375 | expectedTrailMd = Metadata "x-grpc-test-echo-trailing-bin" "\x0a\x0b\x0a\x0b\x0a\x0b" 0 376 | metadata = [ expectedInitMd, expectedTrailMd ] 377 | callOptions' = callOptions <> withMetadata metadata 378 | 379 | checkMetadata :: [Metadata] -> [Metadata] -> IO (Either String ()) 380 | checkMetadata initMd trailMd 381 | | initMd /= [expectedInitMd] = return (Left ("wrong initial metadata, got " ++ show initMd)) 382 | | trailMd /= [expectedTrailMd] = return (Left ("wrong trailing metadata, got " ++ show trailMd)) 383 | | otherwise = return (Right ()) 384 | 385 | procedure1 :: IO (Either String ()) 386 | procedure1 = do 387 | let 388 | req = def { _SimpleRequest'responseSize = 314159 389 | , _SimpleRequest'payload = Just def { 390 | _Payload'body = B.replicate 271828 0 } 391 | } 392 | bracket (newChannel opts) destroyChannel $ \channel -> 393 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 394 | resp <- callUnary ctx callOptions' "/grpc.testing.TestService/UnaryCall" (encodeMessage req) 395 | case resp of 396 | RpcOk (UnaryResult initMd trailMd _) -> 397 | checkMetadata initMd trailMd 398 | RpcError err -> 399 | return (Left (show err)) 400 | 401 | procedure2 :: IO (Either String ()) 402 | procedure2 = do 403 | let 404 | req = def { _StreamingOutputCallRequest'responseParameters = [ def { _ResponseParameters'size = 314159 } ] 405 | , _StreamingOutputCallRequest'payload = Just def { _Payload'body = B.replicate 271828 0 } 406 | } 407 | bracket (newChannel opts) destroyChannel $ \channel -> 408 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 409 | mds <- runRpc $ do 410 | client <- joinReply =<< liftIO (callBidi ctx callOptions' "/grpc.testing.TestService/FullDuplexCall") 411 | sendMessage client (encodeMessage req) 412 | sendHalfClose client 413 | _ <- receiveMessage client 414 | initMd <- recvInitialMetadata client 415 | (RpcStatus trailMd _ _) <- waitForStatus client 416 | closeCall client 417 | return (initMd, trailMd) 418 | case mds of 419 | RpcOk (initMd, trailMd) -> 420 | checkMetadata initMd trailMd 421 | RpcError err -> 422 | return (Left (show err)) 423 | 424 | -- | This test verifies calling unimplemented RPC method returns the UNIMPLEMENTED 425 | -- status code. 426 | -- Server features: N/A 427 | -- Procedure: 428 | -- 1. Client calls `grpc.testing.TestService/UnimplementedCall` with an empty 429 | -- request (defined as `grpc.testing.Empty`): 430 | -- Client asserts: 431 | -- - received status code is 12 (UNIMPLEMENTED) 432 | runUnimplementedMethodTest :: Options -> IO (Either String ()) 433 | runUnimplementedMethodTest opts = 434 | bracket (newChannel opts) destroyChannel $ \channel -> 435 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 436 | resp <- callUnary ctx callOptions "/grpc.testing.TestService/UnimplementedCall" B.empty 437 | case resp of 438 | RpcError (StatusError StatusUnimplemented _) -> return (Right ()) 439 | RpcError err -> return (Left ("RPC failed with the wrong error, got " ++ show err)) 440 | RpcOk _ -> return (Left "RPC succeeded, it should have failed.") 441 | 442 | -- | This test verifies calling an unimplemented server returns the 443 | -- UNIMPLEMENTED status code. 444 | -- 445 | -- Server features: N/A 446 | -- 447 | -- Procedure: 448 | -- 1. Client calls `grpc.testing.UnimplementedService/UnimplementedCall` with an 449 | -- empty request (defined as `grpc.testing.Empty`) 450 | -- 451 | -- Client asserts: 452 | -- 1. received status code is 12 (UNIMPLEMENTED) 453 | runUnimplementedServiceTest :: Options -> IO (Either String ()) 454 | runUnimplementedServiceTest opts = 455 | bracket (newChannel opts) destroyChannel $ \channel -> 456 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 457 | resp <- callUnary ctx callOptions "/grpc.testing.UnimplementedService/UnimplementedCall" B.empty 458 | case resp of 459 | RpcError (StatusError StatusUnimplemented _) -> return (Right ()) 460 | RpcError err -> return (Left ("RPC failed with the wrong error, got " ++ show err)) 461 | RpcOk _ -> return (Left "RPC succeeded, it should have failed.") 462 | 463 | -- | This test verifies that a request can be cancelled after metadata 464 | -- has been sent but before payloads are sent. 465 | -- 466 | -- Server features: 467 | -- 1. [StreamingInputCall][] 468 | -- 469 | -- Procedure: 470 | -- 1. Client starts StreamingInputCall 471 | -- 2. Client immediately cancels request 472 | -- 473 | -- Client asserts: 474 | -- - Call completed with status CANCELLED 475 | runCancelAfterBeginTest :: Options -> IO (Either String ()) 476 | runCancelAfterBeginTest opts = 477 | bracket (newChannel opts) destroyChannel $ \channel -> 478 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 479 | resp <- runRpc $ do 480 | client <- joinReply =<< liftIO (callUpstream ctx callOptions "/grpc.testing.TestService/StreamingInputCall") 481 | cancelCall client 482 | closeCall client 483 | case resp of 484 | RpcError (StatusError StatusCancelled _) -> 485 | return (Right ()) 486 | resp' -> 487 | return (Left ("Wanted StatusCancelled, got=" ++ show resp')) 488 | 489 | -- | This test verifies that an RPC request whose lifetime exceeds its configured 490 | -- timeout value will end with the DeadlineExceeded status. 491 | -- 492 | -- Server features: 493 | -- * [FullDuplexCall][] 494 | -- 495 | -- Procedure: 496 | -- 1. Client calls FullDuplexCall with the following request and sets its timeout 497 | -- to 1ms 498 | -- 499 | -- ``` 500 | -- { 501 | -- payload:{ 502 | -- body: 27182 bytes of zeros 503 | -- } 504 | -- } 505 | -- ``` 506 | -- 507 | -- 2. Client waits 508 | -- 509 | -- Client asserts: 510 | -- - Call completed with status DEADLINE_EXCEEDED. 511 | runTimeoutOnSleepingServerTest :: Options -> IO (Either String ()) 512 | runTimeoutOnSleepingServerTest opts = do 513 | let 514 | callOptions' = callOptions <> withRelativeDeadlineMillis 1 515 | req = def { _StreamingOutputCallRequest'payload = 516 | Just def { _Payload'body = B.replicate 27182 0 } 517 | } 518 | bracket (newChannel opts) destroyChannel $ \channel -> 519 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 520 | resp <- runRpc $ do 521 | call <- liftIO (callBidi ctx callOptions' "/grpc.testing.TestService/FullDuplexCall") 522 | client <- joinReply call 523 | catchE 524 | (sendMessage client (encodeMessage req)) 525 | (\_ -> return ()) 526 | closeCall client 527 | case resp of 528 | RpcError (StatusError StatusDeadlineExceeded _) -> 529 | return (Right ()) 530 | RpcError err -> 531 | return (Left ("got error=" ++ show err ++ ", want=StatusDeadlineExceeded")) 532 | RpcOk () -> return (Left "got status=OK, want=StatusDeadlineExceeded") 533 | 534 | -- |This test verifies that streams support having zero-messages in both 535 | -- directions. 536 | -- Server features: 537 | -- - FullDuplexCall 538 | -- Procedure: 539 | -- 1. Client calls FullDuplexCall and then half-closes 540 | -- Client asserts: 541 | -- - call was successful 542 | -- - exactly zero responses 543 | runEmptyStreamTest :: Options -> IO (Either String ()) 544 | runEmptyStreamTest opts = 545 | bracket (newChannel opts) destroyChannel $ \channel -> 546 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 547 | resp <- runRpc $ do 548 | client <- joinReply =<< liftIO (callBidi ctx callOptions "/grpc.testing.TestService/FullDuplexCall") 549 | sendHalfClose client 550 | msgs <- receiveAllMessages client 551 | closeCall client 552 | return msgs 553 | case resp of 554 | RpcOk msgs 555 | | null msgs -> return (Right ()) 556 | | otherwise -> return (Left ("expected no messages, got " ++ show msgs)) 557 | RpcError err -> 558 | return (Left (show err)) 559 | 560 | 561 | -- | This test verifies that client-only streaming succeeds. 562 | -- 563 | -- Server features: 564 | -- 1. [StreamingInputCall][] 565 | -- 566 | -- Procedure: 567 | -- 1. Client calls StreamingInputCall 568 | -- 2. Client sends: 569 | -- 570 | -- ``` 571 | -- { 572 | -- payload:{ 573 | -- body: 27182 bytes of zeros 574 | -- } 575 | -- } 576 | -- ``` 577 | -- 578 | -- 3. Client then sends: 579 | -- 580 | -- ``` 581 | -- { 582 | -- payload:{ 583 | -- body: 8 bytes of zeros 584 | -- } 585 | -- } 586 | -- ``` 587 | -- 588 | -- 4. Client then sends: 589 | -- 590 | -- ``` 591 | -- { 592 | -- payload:{ 593 | -- body: 1828 bytes of zeros 594 | -- } 595 | -- } 596 | -- ``` 597 | -- 598 | -- 5. Client then sends: 599 | -- 600 | -- ``` 601 | -- { 602 | -- payload:{ 603 | -- body: 45904 bytes of zeros 604 | -- } 605 | -- } 606 | -- ``` 607 | -- 608 | -- 6. Client half-closes 609 | -- 610 | -- Client asserts: 611 | -- - call was successful 612 | -- - response aggregated_payload_size is 74922 613 | runClientStreamingTest :: Options -> IO (Either String ()) 614 | runClientStreamingTest opts = do 615 | let 616 | requestSizes = [27182, 8, 1828, 45904] 617 | expectedResponseSize = 74922 618 | aggPayloadSize = _StreamingInputCallResponse'aggregatedPayloadSize 619 | req n = 620 | def { _StreamingInputCallRequest'payload = Just def { _Payload'body = B.replicate n 0 } 621 | } 622 | bracket (newChannel opts) destroyChannel $ \channel -> 623 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 624 | resp <- runRpc $ do 625 | client <- joinReply =<< liftIO (callUpstream ctx callOptions "/grpc.testing.TestService/StreamingInputCall") 626 | forM_ requestSizes $ \n -> 627 | sendMessage client (encodeMessage (req n)) 628 | sendHalfClose client 629 | msg <- receiveMessage client 630 | closeCall client 631 | case maybe (Left "no message") (decodeMessage . L.toStrict) msg of 632 | Right msg' -> return msg' 633 | Left err -> fail err 634 | case resp of 635 | RpcOk resp' 636 | | aggPayloadSize resp' == expectedResponseSize -> 637 | return (Right ()) 638 | | otherwise -> 639 | return (Left ("aggregated_payload_size=" ++ show (aggPayloadSize resp') ++ ", expected " ++ show expectedResponseSize)) 640 | RpcError err -> 641 | return (Left (show err)) 642 | 643 | runServerStreamingTest :: Options -> IO (Either String ()) 644 | runServerStreamingTest opts = do 645 | let 646 | responseSizes = [31415, 9, 2653, 58979] 647 | req = def { _StreamingOutputCallRequest'responseParameters = 648 | map (\n -> def { _ResponseParameters'size = n }) responseSizes 649 | } 650 | bracket (newChannel opts) destroyChannel $ \channel -> 651 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 652 | resps <- runRpc $ do 653 | client <- joinReply =<< liftIO (callDownstream ctx callOptions "/grpc.testing.TestService/StreamingOutputCall" (encodeMessage req)) 654 | msgs <- receiveAllMessages client 655 | closeCall client 656 | return msgs 657 | case resps of 658 | RpcOk resps' 659 | | length resps' /= length responseSizes -> 660 | return $ Left ("number of received messages mismatch: " ++ show (length resps')) 661 | | otherwise -> return $ 662 | forM_ (responseSizes `zip` resps') $ \(expectedSize, resp) -> do 663 | msg <- mapLeft ("proto decoder says: " ++) (decodeMessage (L.toStrict resp)) 664 | payload <- maybeToEither "no payload" (_StreamingOutputCallResponse'payload msg) 665 | let 666 | expectedBody = B.replicate (fromIntegral expectedSize) 0 667 | unless (_Payload'body payload == expectedBody) $ 668 | Left "payload does not match" 669 | RpcError err -> 670 | return (Left (show err)) 671 | 672 | runServerStreamingWithSlowConsumerTest :: Options -> IO (Either String ()) 673 | runServerStreamingWithSlowConsumerTest opts = do 674 | let 675 | responseSize = 1030 676 | responsesCount = 2000 677 | delaySeconds = 20 678 | delay = delaySeconds * 1000 679 | req = def { _StreamingOutputCallRequest'responseParameters = 680 | replicate responsesCount def { _ResponseParameters'size = responseSize } 681 | } 682 | expectedBody = B.replicate (fromIntegral responseSize) 0 683 | go client acc = do 684 | maybeResponse <- receiveMessage client 685 | case maybeResponse of 686 | Nothing -> return $ Right (reverse acc) 687 | Just resp -> do 688 | let 689 | eitherMsg = do 690 | msg <- mapLeft ("proto decoder says: " ++) $ decodeMessage (L.toStrict resp) 691 | payload <- maybeToEither "no payload" (_StreamingOutputCallResponse'payload msg) 692 | unless (_Payload'body payload == expectedBody) $ 693 | Left "payload does not match" 694 | return msg 695 | case eitherMsg of 696 | Left err -> 697 | return (Left err) 698 | Right msg -> do 699 | liftIO (threadDelay delay) 700 | go client (msg : acc) 701 | bracket (newChannel opts) destroyChannel $ \channel -> 702 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 703 | resp <- runRpc $ do 704 | client <- joinReply =<< liftIO (callDownstream ctx mempty "/grpc.testing.TestService/StreamingOutputCall" (encodeMessage req)) 705 | msgs <- go client [] 706 | closeCall client 707 | return msgs 708 | case resp of 709 | RpcOk (Right msgs) 710 | | length msgs == responsesCount -> 711 | return (Right ()) 712 | | otherwise -> 713 | return (Left ("responses count does not match: " ++ show (length msgs))) 714 | RpcOk (Left err) -> 715 | return (Left err) 716 | RpcError err -> 717 | return (Left (show err)) 718 | 719 | -- | This test verifies unary calls succeed in sending messages, and propagate 720 | -- back status code and message sent along with the messages. 721 | -- 722 | -- Server features: 723 | -- * [UnaryCall][] 724 | -- * [FullDuplexCall][] 725 | -- * [Echo Status][] 726 | -- Procedure: 727 | -- 1. Client calls UnaryCall with: 728 | -- 729 | -- ``` 730 | -- { 731 | -- response_status:{ 732 | -- code: 2 733 | -- message: "test status message" 734 | -- } 735 | -- } 736 | -- ``` 737 | -- 738 | -- 2. Client calls FullDuplexCall with: 739 | -- 740 | -- ``` 741 | -- { 742 | -- response_status:{ 743 | -- code: 2 744 | -- message: "test status message" 745 | -- } 746 | -- } 747 | -- ``` 748 | -- 749 | -- and then half-closes 750 | -- Client asserts: 751 | -- * received status code is the same as the sent code for both Procedure steps 1 752 | -- and 2 753 | -- * received status message is the same as the sent message for both Procedure 754 | -- steps 1 and 2 755 | runStatusCodeAndMessageTest :: Options -> IO (Either String ()) 756 | runStatusCodeAndMessageTest opts = 757 | seq_ 758 | [ ("procedure1", runStatusCodeAndMessageTest1 opts) 759 | , ("procedure2", runStatusCodeAndMessageTest2 opts) ] 760 | 761 | runStatusCodeAndMessageTest1 :: Options -> IO (Either String ()) 762 | runStatusCodeAndMessageTest1 opts = do 763 | let 764 | req = def { _SimpleRequest'responseStatus = 765 | Just $ def { _EchoStatus'code = 2 766 | , _EchoStatus'message = "test status message" 767 | } 768 | } 769 | bracket (newChannel opts) destroyChannel $ \channel -> 770 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 771 | resp <- callUnary ctx callOptions "/grpc.testing.TestService/UnaryCall" (encodeMessage req) 772 | case resp of 773 | RpcError (StatusError StatusUnknown "test status message") -> return (Right ()) 774 | _ -> return (Left ("expected (unknown, \"test status message\"), got= " ++ show resp)) 775 | 776 | runStatusCodeAndMessageTest2 :: Options -> IO (Either String ()) 777 | runStatusCodeAndMessageTest2 opts = do 778 | let 779 | req = def { _StreamingOutputCallRequest'responseStatus = 780 | Just $ def { _EchoStatus'code = 2 781 | , _EchoStatus'message = "test status message" 782 | } 783 | } 784 | bracket (newChannel opts) destroyChannel $ \channel -> 785 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 786 | resp <- runRpc $ do 787 | client <- joinReply =<< liftIO (callBidi ctx callOptions "/grpc.testing.TestService/FullDuplexCall") 788 | sendMessage client (encodeMessage req) 789 | sendHalfClose client 790 | closeCall client 791 | case resp of 792 | RpcError (StatusError StatusUnknown "test status message") -> return (Right ()) 793 | _ -> return (Left ("expected (unknown, \"test status message\"), got= " ++ show resp)) 794 | 795 | -- | This test verifies that full duplex bidi is supported. 796 | -- 797 | -- Server features: 798 | -- 1. [FullDuplexCall][] 799 | -- 800 | -- Procedure: 801 | -- 1. Client calls FullDuplexCall with: 802 | -- 803 | -- ``` 804 | -- { 805 | -- response_parameters:{ 806 | -- size: 31415 807 | -- } 808 | -- payload:{ 809 | -- body: 27182 bytes of zeros 810 | -- } 811 | -- } 812 | -- ``` 813 | -- 814 | -- 2. After getting a reply, it sends: 815 | -- 816 | -- ``` 817 | -- { 818 | -- response_parameters:{ 819 | -- size: 9 820 | -- } 821 | -- payload:{ 822 | -- body: 8 bytes of zeros 823 | -- } 824 | -- } 825 | -- ``` 826 | -- 827 | -- 3. After getting a reply, it sends: 828 | -- 829 | -- ``` 830 | -- { 831 | -- response_parameters:{ 832 | -- size: 2653 833 | -- } 834 | -- payload:{ 835 | -- body: 1828 bytes of zeros 836 | -- } 837 | -- } 838 | -- ``` 839 | -- 840 | -- 4. After getting a reply, it sends: 841 | -- 842 | -- ``` 843 | -- { 844 | -- response_parameters:{ 845 | -- size: 58979 846 | -- } 847 | -- payload:{ 848 | -- body: 45904 bytes of zeros 849 | -- } 850 | -- } 851 | -- ``` 852 | -- 853 | -- 5. After getting a reply, client half-closes 854 | -- 855 | -- Client asserts: 856 | -- - call was successful 857 | -- - exactly four responses 858 | -- - response payload bodies are sized (in order): 31415, 9, 2653, 58979 859 | -- - clients are free to assert that the response payload body contents are zero 860 | -- and comparing the entire response messages against golden responses 861 | runPingPongTest :: Options -> IO (Either String ()) 862 | runPingPongTest opts = do 863 | let responseSizes = [31415, 9, 2653, 58979] 864 | payloadSizes = [27182, 8, 1828, 45904] 865 | req respSize payloadSize = 866 | def { _StreamingOutputCallRequest'responseParameters = [ def { _ResponseParameters'size = respSize } ] 867 | , _StreamingOutputCallRequest'payload = Just def { _Payload'body = B.replicate payloadSize 0 } 868 | } 869 | bracket (newChannel opts) destroyChannel $ \channel -> 870 | bracket (newClientContext channel) destroyClientContext $ \ctx -> do 871 | mds <- runRpc $ do 872 | client <- joinReply =<< liftIO (callBidi ctx callOptions "/grpc.testing.TestService/FullDuplexCall") 873 | forM_ (zip responseSizes payloadSizes) $ \(respSize, payloadSize) -> do 874 | sendMessage client (encodeMessage (req respSize payloadSize)) 875 | _resp <- receiveMessage client 876 | -- TODO: decode response and verify length of response size field 877 | return () 878 | sendHalfClose client 879 | Nothing <- receiveMessage client 880 | closeCall client 881 | case mds of 882 | RpcOk () -> 883 | return (Right ()) 884 | RpcError err -> 885 | return (Left (show err)) 886 | -------------------------------------------------------------------------------- /tests/interop_client/proto/Proto/Src/Proto/Grpc/Testing/Empty.hs: -------------------------------------------------------------------------------- 1 | {- This file was auto-generated from src/proto/grpc/testing/empty.proto by the proto-lens-protoc program. -} 2 | {-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, 3 | MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, 4 | PatternSynonyms #-} 5 | {-# OPTIONS_GHC -fno-warn-unused-imports#-} 6 | module Proto.Src.Proto.Grpc.Testing.Empty where 7 | import qualified Prelude 8 | import qualified Data.Int 9 | import qualified Data.Word 10 | 11 | import qualified Data.ProtoLens 12 | import qualified Data.ProtoLens.Message.Enum 13 | import qualified Lens.Family2 14 | import qualified Lens.Family2.Unchecked 15 | import qualified Data.Default.Class 16 | import qualified Data.Text 17 | import qualified Data.Map 18 | import qualified Data.ByteString 19 | 20 | data Empty = Empty{} 21 | deriving (Prelude.Show, Prelude.Eq) 22 | 23 | instance Data.Default.Class.Default Empty where 24 | def = Empty{} 25 | 26 | instance Data.ProtoLens.Message Empty where 27 | descriptor 28 | = let in 29 | Data.ProtoLens.MessageDescriptor (Data.Map.fromList []) 30 | (Data.Map.fromList []) -------------------------------------------------------------------------------- /tests/interop_client/proto/Proto/Src/Proto/Grpc/Testing/Messages.hs: -------------------------------------------------------------------------------- 1 | {- This file was auto-generated from src/proto/grpc/testing/messages.proto by the proto-lens-protoc program. -} 2 | {-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, 3 | MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, 4 | PatternSynonyms #-} 5 | {-# OPTIONS_GHC -fno-warn-unused-imports#-} 6 | module Proto.Src.Proto.Grpc.Testing.Messages where 7 | import qualified Prelude 8 | import qualified Data.Int 9 | import qualified Data.Word 10 | 11 | import qualified Data.ProtoLens 12 | import qualified Data.ProtoLens.Message.Enum 13 | import qualified Lens.Family2 14 | import qualified Lens.Family2.Unchecked 15 | import qualified Data.Default.Class 16 | import qualified Data.Text 17 | import qualified Data.Map 18 | import qualified Data.ByteString 19 | 20 | data BoolValue = BoolValue{_BoolValue'value :: Prelude.Bool} 21 | deriving (Prelude.Show, Prelude.Eq) 22 | 23 | type instance Data.ProtoLens.Field "value" BoolValue = Prelude.Bool 24 | 25 | instance Data.ProtoLens.HasField "value" BoolValue BoolValue where 26 | field _ 27 | = Lens.Family2.Unchecked.lens _BoolValue'value 28 | (\ x__ y__ -> x__{_BoolValue'value = y__}) 29 | 30 | instance Data.Default.Class.Default BoolValue where 31 | def = BoolValue{_BoolValue'value = Data.ProtoLens.fieldDefault} 32 | 33 | instance Data.ProtoLens.Message BoolValue where 34 | descriptor 35 | = let value__field_descriptor 36 | = Data.ProtoLens.FieldDescriptor "value" 37 | (Data.ProtoLens.BoolField :: 38 | Data.ProtoLens.FieldTypeDescriptor Prelude.Bool) 39 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional value) 40 | in 41 | Data.ProtoLens.MessageDescriptor 42 | (Data.Map.fromList 43 | [(Data.ProtoLens.Tag 1, value__field_descriptor)]) 44 | (Data.Map.fromList [("value", value__field_descriptor)]) 45 | 46 | data EchoStatus = EchoStatus{_EchoStatus'code :: Data.Int.Int32, 47 | _EchoStatus'message :: Data.Text.Text} 48 | deriving (Prelude.Show, Prelude.Eq) 49 | 50 | type instance Data.ProtoLens.Field "code" EchoStatus = 51 | Data.Int.Int32 52 | 53 | instance Data.ProtoLens.HasField "code" EchoStatus EchoStatus where 54 | field _ 55 | = Lens.Family2.Unchecked.lens _EchoStatus'code 56 | (\ x__ y__ -> x__{_EchoStatus'code = y__}) 57 | 58 | type instance Data.ProtoLens.Field "message" EchoStatus = 59 | Data.Text.Text 60 | 61 | instance Data.ProtoLens.HasField "message" EchoStatus EchoStatus 62 | where 63 | field _ 64 | = Lens.Family2.Unchecked.lens _EchoStatus'message 65 | (\ x__ y__ -> x__{_EchoStatus'message = y__}) 66 | 67 | instance Data.Default.Class.Default EchoStatus where 68 | def 69 | = EchoStatus{_EchoStatus'code = Data.ProtoLens.fieldDefault, 70 | _EchoStatus'message = Data.ProtoLens.fieldDefault} 71 | 72 | instance Data.ProtoLens.Message EchoStatus where 73 | descriptor 74 | = let code__field_descriptor 75 | = Data.ProtoLens.FieldDescriptor "code" 76 | (Data.ProtoLens.Int32Field :: 77 | Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) 78 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional code) 79 | message__field_descriptor 80 | = Data.ProtoLens.FieldDescriptor "message" 81 | (Data.ProtoLens.StringField :: 82 | Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) 83 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional message) 84 | in 85 | Data.ProtoLens.MessageDescriptor 86 | (Data.Map.fromList 87 | [(Data.ProtoLens.Tag 1, code__field_descriptor), 88 | (Data.ProtoLens.Tag 2, message__field_descriptor)]) 89 | (Data.Map.fromList 90 | [("code", code__field_descriptor), 91 | ("message", message__field_descriptor)]) 92 | 93 | data Payload = Payload{_Payload'type' :: PayloadType, 94 | _Payload'body :: Data.ByteString.ByteString} 95 | deriving (Prelude.Show, Prelude.Eq) 96 | 97 | type instance Data.ProtoLens.Field "type'" Payload = PayloadType 98 | 99 | instance Data.ProtoLens.HasField "type'" Payload Payload where 100 | field _ 101 | = Lens.Family2.Unchecked.lens _Payload'type' 102 | (\ x__ y__ -> x__{_Payload'type' = y__}) 103 | 104 | type instance Data.ProtoLens.Field "body" Payload = 105 | Data.ByteString.ByteString 106 | 107 | instance Data.ProtoLens.HasField "body" Payload Payload where 108 | field _ 109 | = Lens.Family2.Unchecked.lens _Payload'body 110 | (\ x__ y__ -> x__{_Payload'body = y__}) 111 | 112 | instance Data.Default.Class.Default Payload where 113 | def 114 | = Payload{_Payload'type' = Data.Default.Class.def, 115 | _Payload'body = Data.ProtoLens.fieldDefault} 116 | 117 | instance Data.ProtoLens.Message Payload where 118 | descriptor 119 | = let type'__field_descriptor 120 | = Data.ProtoLens.FieldDescriptor "type" 121 | (Data.ProtoLens.EnumField :: 122 | Data.ProtoLens.FieldTypeDescriptor PayloadType) 123 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional type') 124 | body__field_descriptor 125 | = Data.ProtoLens.FieldDescriptor "body" 126 | (Data.ProtoLens.BytesField :: 127 | Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) 128 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional body) 129 | in 130 | Data.ProtoLens.MessageDescriptor 131 | (Data.Map.fromList 132 | [(Data.ProtoLens.Tag 1, type'__field_descriptor), 133 | (Data.ProtoLens.Tag 2, body__field_descriptor)]) 134 | (Data.Map.fromList 135 | [("type", type'__field_descriptor), 136 | ("body", body__field_descriptor)]) 137 | 138 | data PayloadType = COMPRESSABLE 139 | deriving (Prelude.Show, Prelude.Eq) 140 | 141 | instance Data.Default.Class.Default PayloadType where 142 | def = COMPRESSABLE 143 | 144 | instance Data.ProtoLens.FieldDefault PayloadType where 145 | fieldDefault = COMPRESSABLE 146 | 147 | instance Data.ProtoLens.MessageEnum PayloadType where 148 | maybeToEnum 0 = Prelude.Just COMPRESSABLE 149 | maybeToEnum _ = Prelude.Nothing 150 | showEnum COMPRESSABLE = "COMPRESSABLE" 151 | readEnum "COMPRESSABLE" = Prelude.Just COMPRESSABLE 152 | readEnum _ = Prelude.Nothing 153 | 154 | instance Prelude.Enum PayloadType where 155 | toEnum k__ 156 | = Prelude.maybe 157 | (Prelude.error 158 | ((Prelude.++) "toEnum: unknown value for enum PayloadType: " 159 | (Prelude.show k__))) 160 | Prelude.id 161 | (Data.ProtoLens.maybeToEnum k__) 162 | fromEnum COMPRESSABLE = 0 163 | succ COMPRESSABLE 164 | = Prelude.error 165 | "Ident \"PayloadType\".Ident \"succ\": bad argument Ident \"COMPRESSABLE\". This value would be out of bounds." 166 | pred COMPRESSABLE 167 | = Prelude.error 168 | "Ident \"PayloadType\".Ident \"pred\": bad argument Ident \"COMPRESSABLE\". This value would be out of bounds." 169 | enumFrom = Data.ProtoLens.Message.Enum.messageEnumFrom 170 | enumFromTo = Data.ProtoLens.Message.Enum.messageEnumFromTo 171 | enumFromThen = Data.ProtoLens.Message.Enum.messageEnumFromThen 172 | enumFromThenTo = Data.ProtoLens.Message.Enum.messageEnumFromThenTo 173 | 174 | instance Prelude.Bounded PayloadType where 175 | minBound = COMPRESSABLE 176 | maxBound = COMPRESSABLE 177 | 178 | data ReconnectInfo = ReconnectInfo{_ReconnectInfo'passed :: 179 | Prelude.Bool, 180 | _ReconnectInfo'backoffMs :: [Data.Int.Int32]} 181 | deriving (Prelude.Show, Prelude.Eq) 182 | 183 | type instance Data.ProtoLens.Field "passed" ReconnectInfo = 184 | Prelude.Bool 185 | 186 | instance Data.ProtoLens.HasField "passed" ReconnectInfo 187 | ReconnectInfo where 188 | field _ 189 | = Lens.Family2.Unchecked.lens _ReconnectInfo'passed 190 | (\ x__ y__ -> x__{_ReconnectInfo'passed = y__}) 191 | 192 | type instance Data.ProtoLens.Field "backoffMs" ReconnectInfo = 193 | [Data.Int.Int32] 194 | 195 | instance Data.ProtoLens.HasField "backoffMs" ReconnectInfo 196 | ReconnectInfo where 197 | field _ 198 | = Lens.Family2.Unchecked.lens _ReconnectInfo'backoffMs 199 | (\ x__ y__ -> x__{_ReconnectInfo'backoffMs = y__}) 200 | 201 | instance Data.Default.Class.Default ReconnectInfo where 202 | def 203 | = ReconnectInfo{_ReconnectInfo'passed = 204 | Data.ProtoLens.fieldDefault, 205 | _ReconnectInfo'backoffMs = []} 206 | 207 | instance Data.ProtoLens.Message ReconnectInfo where 208 | descriptor 209 | = let passed__field_descriptor 210 | = Data.ProtoLens.FieldDescriptor "passed" 211 | (Data.ProtoLens.BoolField :: 212 | Data.ProtoLens.FieldTypeDescriptor Prelude.Bool) 213 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional passed) 214 | backoffMs__field_descriptor 215 | = Data.ProtoLens.FieldDescriptor "backoff_ms" 216 | (Data.ProtoLens.Int32Field :: 217 | Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) 218 | (Data.ProtoLens.RepeatedField Data.ProtoLens.Unpacked backoffMs) 219 | in 220 | Data.ProtoLens.MessageDescriptor 221 | (Data.Map.fromList 222 | [(Data.ProtoLens.Tag 1, passed__field_descriptor), 223 | (Data.ProtoLens.Tag 2, backoffMs__field_descriptor)]) 224 | (Data.Map.fromList 225 | [("passed", passed__field_descriptor), 226 | ("backoff_ms", backoffMs__field_descriptor)]) 227 | 228 | data ReconnectParams = ReconnectParams{_ReconnectParams'maxReconnectBackoffMs 229 | :: Data.Int.Int32} 230 | deriving (Prelude.Show, Prelude.Eq) 231 | 232 | type instance 233 | Data.ProtoLens.Field "maxReconnectBackoffMs" ReconnectParams = 234 | Data.Int.Int32 235 | 236 | instance Data.ProtoLens.HasField "maxReconnectBackoffMs" 237 | ReconnectParams ReconnectParams where 238 | field _ 239 | = Lens.Family2.Unchecked.lens 240 | _ReconnectParams'maxReconnectBackoffMs 241 | (\ x__ y__ -> x__{_ReconnectParams'maxReconnectBackoffMs = y__}) 242 | 243 | instance Data.Default.Class.Default ReconnectParams where 244 | def 245 | = ReconnectParams{_ReconnectParams'maxReconnectBackoffMs = 246 | Data.ProtoLens.fieldDefault} 247 | 248 | instance Data.ProtoLens.Message ReconnectParams where 249 | descriptor 250 | = let maxReconnectBackoffMs__field_descriptor 251 | = Data.ProtoLens.FieldDescriptor "max_reconnect_backoff_ms" 252 | (Data.ProtoLens.Int32Field :: 253 | Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) 254 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional 255 | maxReconnectBackoffMs) 256 | in 257 | Data.ProtoLens.MessageDescriptor 258 | (Data.Map.fromList 259 | [(Data.ProtoLens.Tag 1, maxReconnectBackoffMs__field_descriptor)]) 260 | (Data.Map.fromList 261 | [("max_reconnect_backoff_ms", 262 | maxReconnectBackoffMs__field_descriptor)]) 263 | 264 | data ResponseParameters = ResponseParameters{_ResponseParameters'size 265 | :: Data.Int.Int32, 266 | _ResponseParameters'intervalUs :: Data.Int.Int32, 267 | _ResponseParameters'compressed :: 268 | Prelude.Maybe BoolValue} 269 | deriving (Prelude.Show, Prelude.Eq) 270 | 271 | type instance Data.ProtoLens.Field "size" ResponseParameters = 272 | Data.Int.Int32 273 | 274 | instance Data.ProtoLens.HasField "size" ResponseParameters 275 | ResponseParameters where 276 | field _ 277 | = Lens.Family2.Unchecked.lens _ResponseParameters'size 278 | (\ x__ y__ -> x__{_ResponseParameters'size = y__}) 279 | 280 | type instance Data.ProtoLens.Field "intervalUs" ResponseParameters 281 | = Data.Int.Int32 282 | 283 | instance Data.ProtoLens.HasField "intervalUs" ResponseParameters 284 | ResponseParameters where 285 | field _ 286 | = Lens.Family2.Unchecked.lens _ResponseParameters'intervalUs 287 | (\ x__ y__ -> x__{_ResponseParameters'intervalUs = y__}) 288 | 289 | type instance Data.ProtoLens.Field "compressed" ResponseParameters 290 | = BoolValue 291 | 292 | instance Data.ProtoLens.HasField "compressed" ResponseParameters 293 | ResponseParameters where 294 | field _ 295 | = (Prelude..) maybe'compressed 296 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 297 | 298 | type instance 299 | Data.ProtoLens.Field "maybe'compressed" ResponseParameters = 300 | Prelude.Maybe BoolValue 301 | 302 | instance Data.ProtoLens.HasField "maybe'compressed" 303 | ResponseParameters ResponseParameters where 304 | field _ 305 | = Lens.Family2.Unchecked.lens _ResponseParameters'compressed 306 | (\ x__ y__ -> x__{_ResponseParameters'compressed = y__}) 307 | 308 | instance Data.Default.Class.Default ResponseParameters where 309 | def 310 | = ResponseParameters{_ResponseParameters'size = 311 | Data.ProtoLens.fieldDefault, 312 | _ResponseParameters'intervalUs = Data.ProtoLens.fieldDefault, 313 | _ResponseParameters'compressed = Prelude.Nothing} 314 | 315 | instance Data.ProtoLens.Message ResponseParameters where 316 | descriptor 317 | = let size__field_descriptor 318 | = Data.ProtoLens.FieldDescriptor "size" 319 | (Data.ProtoLens.Int32Field :: 320 | Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) 321 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional size) 322 | intervalUs__field_descriptor 323 | = Data.ProtoLens.FieldDescriptor "interval_us" 324 | (Data.ProtoLens.Int32Field :: 325 | Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) 326 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional intervalUs) 327 | compressed__field_descriptor 328 | = Data.ProtoLens.FieldDescriptor "compressed" 329 | (Data.ProtoLens.MessageField :: 330 | Data.ProtoLens.FieldTypeDescriptor BoolValue) 331 | (Data.ProtoLens.OptionalField maybe'compressed) 332 | in 333 | Data.ProtoLens.MessageDescriptor 334 | (Data.Map.fromList 335 | [(Data.ProtoLens.Tag 1, size__field_descriptor), 336 | (Data.ProtoLens.Tag 2, intervalUs__field_descriptor), 337 | (Data.ProtoLens.Tag 3, compressed__field_descriptor)]) 338 | (Data.Map.fromList 339 | [("size", size__field_descriptor), 340 | ("interval_us", intervalUs__field_descriptor), 341 | ("compressed", compressed__field_descriptor)]) 342 | 343 | data SimpleRequest = SimpleRequest{_SimpleRequest'responseType :: 344 | PayloadType, 345 | _SimpleRequest'responseSize :: Data.Int.Int32, 346 | _SimpleRequest'payload :: Prelude.Maybe Payload, 347 | _SimpleRequest'fillUsername :: Prelude.Bool, 348 | _SimpleRequest'fillOauthScope :: Prelude.Bool, 349 | _SimpleRequest'responseCompressed :: Prelude.Maybe BoolValue, 350 | _SimpleRequest'responseStatus :: Prelude.Maybe EchoStatus, 351 | _SimpleRequest'expectCompressed :: Prelude.Maybe BoolValue} 352 | deriving (Prelude.Show, Prelude.Eq) 353 | 354 | type instance Data.ProtoLens.Field "responseType" SimpleRequest = 355 | PayloadType 356 | 357 | instance Data.ProtoLens.HasField "responseType" SimpleRequest 358 | SimpleRequest where 359 | field _ 360 | = Lens.Family2.Unchecked.lens _SimpleRequest'responseType 361 | (\ x__ y__ -> x__{_SimpleRequest'responseType = y__}) 362 | 363 | type instance Data.ProtoLens.Field "responseSize" SimpleRequest = 364 | Data.Int.Int32 365 | 366 | instance Data.ProtoLens.HasField "responseSize" SimpleRequest 367 | SimpleRequest where 368 | field _ 369 | = Lens.Family2.Unchecked.lens _SimpleRequest'responseSize 370 | (\ x__ y__ -> x__{_SimpleRequest'responseSize = y__}) 371 | 372 | type instance Data.ProtoLens.Field "payload" SimpleRequest = 373 | Payload 374 | 375 | instance Data.ProtoLens.HasField "payload" SimpleRequest 376 | SimpleRequest where 377 | field _ 378 | = (Prelude..) maybe'payload 379 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 380 | 381 | type instance Data.ProtoLens.Field "maybe'payload" SimpleRequest = 382 | Prelude.Maybe Payload 383 | 384 | instance Data.ProtoLens.HasField "maybe'payload" SimpleRequest 385 | SimpleRequest where 386 | field _ 387 | = Lens.Family2.Unchecked.lens _SimpleRequest'payload 388 | (\ x__ y__ -> x__{_SimpleRequest'payload = y__}) 389 | 390 | type instance Data.ProtoLens.Field "fillUsername" SimpleRequest = 391 | Prelude.Bool 392 | 393 | instance Data.ProtoLens.HasField "fillUsername" SimpleRequest 394 | SimpleRequest where 395 | field _ 396 | = Lens.Family2.Unchecked.lens _SimpleRequest'fillUsername 397 | (\ x__ y__ -> x__{_SimpleRequest'fillUsername = y__}) 398 | 399 | type instance Data.ProtoLens.Field "fillOauthScope" SimpleRequest = 400 | Prelude.Bool 401 | 402 | instance Data.ProtoLens.HasField "fillOauthScope" SimpleRequest 403 | SimpleRequest where 404 | field _ 405 | = Lens.Family2.Unchecked.lens _SimpleRequest'fillOauthScope 406 | (\ x__ y__ -> x__{_SimpleRequest'fillOauthScope = y__}) 407 | 408 | type instance 409 | Data.ProtoLens.Field "responseCompressed" SimpleRequest = BoolValue 410 | 411 | instance Data.ProtoLens.HasField "responseCompressed" SimpleRequest 412 | SimpleRequest where 413 | field _ 414 | = (Prelude..) maybe'responseCompressed 415 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 416 | 417 | type instance 418 | Data.ProtoLens.Field "maybe'responseCompressed" SimpleRequest = 419 | Prelude.Maybe BoolValue 420 | 421 | instance Data.ProtoLens.HasField "maybe'responseCompressed" 422 | SimpleRequest SimpleRequest where 423 | field _ 424 | = Lens.Family2.Unchecked.lens _SimpleRequest'responseCompressed 425 | (\ x__ y__ -> x__{_SimpleRequest'responseCompressed = y__}) 426 | 427 | type instance Data.ProtoLens.Field "responseStatus" SimpleRequest = 428 | EchoStatus 429 | 430 | instance Data.ProtoLens.HasField "responseStatus" SimpleRequest 431 | SimpleRequest where 432 | field _ 433 | = (Prelude..) maybe'responseStatus 434 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 435 | 436 | type instance 437 | Data.ProtoLens.Field "maybe'responseStatus" SimpleRequest = 438 | Prelude.Maybe EchoStatus 439 | 440 | instance Data.ProtoLens.HasField "maybe'responseStatus" 441 | SimpleRequest SimpleRequest where 442 | field _ 443 | = Lens.Family2.Unchecked.lens _SimpleRequest'responseStatus 444 | (\ x__ y__ -> x__{_SimpleRequest'responseStatus = y__}) 445 | 446 | type instance Data.ProtoLens.Field "expectCompressed" SimpleRequest 447 | = BoolValue 448 | 449 | instance Data.ProtoLens.HasField "expectCompressed" SimpleRequest 450 | SimpleRequest where 451 | field _ 452 | = (Prelude..) maybe'expectCompressed 453 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 454 | 455 | type instance 456 | Data.ProtoLens.Field "maybe'expectCompressed" SimpleRequest = 457 | Prelude.Maybe BoolValue 458 | 459 | instance Data.ProtoLens.HasField "maybe'expectCompressed" 460 | SimpleRequest SimpleRequest where 461 | field _ 462 | = Lens.Family2.Unchecked.lens _SimpleRequest'expectCompressed 463 | (\ x__ y__ -> x__{_SimpleRequest'expectCompressed = y__}) 464 | 465 | instance Data.Default.Class.Default SimpleRequest where 466 | def 467 | = SimpleRequest{_SimpleRequest'responseType = 468 | Data.Default.Class.def, 469 | _SimpleRequest'responseSize = Data.ProtoLens.fieldDefault, 470 | _SimpleRequest'payload = Prelude.Nothing, 471 | _SimpleRequest'fillUsername = Data.ProtoLens.fieldDefault, 472 | _SimpleRequest'fillOauthScope = Data.ProtoLens.fieldDefault, 473 | _SimpleRequest'responseCompressed = Prelude.Nothing, 474 | _SimpleRequest'responseStatus = Prelude.Nothing, 475 | _SimpleRequest'expectCompressed = Prelude.Nothing} 476 | 477 | instance Data.ProtoLens.Message SimpleRequest where 478 | descriptor 479 | = let responseType__field_descriptor 480 | = Data.ProtoLens.FieldDescriptor "response_type" 481 | (Data.ProtoLens.EnumField :: 482 | Data.ProtoLens.FieldTypeDescriptor PayloadType) 483 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional responseType) 484 | responseSize__field_descriptor 485 | = Data.ProtoLens.FieldDescriptor "response_size" 486 | (Data.ProtoLens.Int32Field :: 487 | Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) 488 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional responseSize) 489 | payload__field_descriptor 490 | = Data.ProtoLens.FieldDescriptor "payload" 491 | (Data.ProtoLens.MessageField :: 492 | Data.ProtoLens.FieldTypeDescriptor Payload) 493 | (Data.ProtoLens.OptionalField maybe'payload) 494 | fillUsername__field_descriptor 495 | = Data.ProtoLens.FieldDescriptor "fill_username" 496 | (Data.ProtoLens.BoolField :: 497 | Data.ProtoLens.FieldTypeDescriptor Prelude.Bool) 498 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional fillUsername) 499 | fillOauthScope__field_descriptor 500 | = Data.ProtoLens.FieldDescriptor "fill_oauth_scope" 501 | (Data.ProtoLens.BoolField :: 502 | Data.ProtoLens.FieldTypeDescriptor Prelude.Bool) 503 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional fillOauthScope) 504 | responseCompressed__field_descriptor 505 | = Data.ProtoLens.FieldDescriptor "response_compressed" 506 | (Data.ProtoLens.MessageField :: 507 | Data.ProtoLens.FieldTypeDescriptor BoolValue) 508 | (Data.ProtoLens.OptionalField maybe'responseCompressed) 509 | responseStatus__field_descriptor 510 | = Data.ProtoLens.FieldDescriptor "response_status" 511 | (Data.ProtoLens.MessageField :: 512 | Data.ProtoLens.FieldTypeDescriptor EchoStatus) 513 | (Data.ProtoLens.OptionalField maybe'responseStatus) 514 | expectCompressed__field_descriptor 515 | = Data.ProtoLens.FieldDescriptor "expect_compressed" 516 | (Data.ProtoLens.MessageField :: 517 | Data.ProtoLens.FieldTypeDescriptor BoolValue) 518 | (Data.ProtoLens.OptionalField maybe'expectCompressed) 519 | in 520 | Data.ProtoLens.MessageDescriptor 521 | (Data.Map.fromList 522 | [(Data.ProtoLens.Tag 1, responseType__field_descriptor), 523 | (Data.ProtoLens.Tag 2, responseSize__field_descriptor), 524 | (Data.ProtoLens.Tag 3, payload__field_descriptor), 525 | (Data.ProtoLens.Tag 4, fillUsername__field_descriptor), 526 | (Data.ProtoLens.Tag 5, fillOauthScope__field_descriptor), 527 | (Data.ProtoLens.Tag 6, responseCompressed__field_descriptor), 528 | (Data.ProtoLens.Tag 7, responseStatus__field_descriptor), 529 | (Data.ProtoLens.Tag 8, expectCompressed__field_descriptor)]) 530 | (Data.Map.fromList 531 | [("response_type", responseType__field_descriptor), 532 | ("response_size", responseSize__field_descriptor), 533 | ("payload", payload__field_descriptor), 534 | ("fill_username", fillUsername__field_descriptor), 535 | ("fill_oauth_scope", fillOauthScope__field_descriptor), 536 | ("response_compressed", responseCompressed__field_descriptor), 537 | ("response_status", responseStatus__field_descriptor), 538 | ("expect_compressed", expectCompressed__field_descriptor)]) 539 | 540 | data SimpleResponse = SimpleResponse{_SimpleResponse'payload :: 541 | Prelude.Maybe Payload, 542 | _SimpleResponse'username :: Data.Text.Text, 543 | _SimpleResponse'oauthScope :: Data.Text.Text} 544 | deriving (Prelude.Show, Prelude.Eq) 545 | 546 | type instance Data.ProtoLens.Field "payload" SimpleResponse = 547 | Payload 548 | 549 | instance Data.ProtoLens.HasField "payload" SimpleResponse 550 | SimpleResponse where 551 | field _ 552 | = (Prelude..) maybe'payload 553 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 554 | 555 | type instance Data.ProtoLens.Field "maybe'payload" SimpleResponse = 556 | Prelude.Maybe Payload 557 | 558 | instance Data.ProtoLens.HasField "maybe'payload" SimpleResponse 559 | SimpleResponse where 560 | field _ 561 | = Lens.Family2.Unchecked.lens _SimpleResponse'payload 562 | (\ x__ y__ -> x__{_SimpleResponse'payload = y__}) 563 | 564 | type instance Data.ProtoLens.Field "username" SimpleResponse = 565 | Data.Text.Text 566 | 567 | instance Data.ProtoLens.HasField "username" SimpleResponse 568 | SimpleResponse where 569 | field _ 570 | = Lens.Family2.Unchecked.lens _SimpleResponse'username 571 | (\ x__ y__ -> x__{_SimpleResponse'username = y__}) 572 | 573 | type instance Data.ProtoLens.Field "oauthScope" SimpleResponse = 574 | Data.Text.Text 575 | 576 | instance Data.ProtoLens.HasField "oauthScope" SimpleResponse 577 | SimpleResponse where 578 | field _ 579 | = Lens.Family2.Unchecked.lens _SimpleResponse'oauthScope 580 | (\ x__ y__ -> x__{_SimpleResponse'oauthScope = y__}) 581 | 582 | instance Data.Default.Class.Default SimpleResponse where 583 | def 584 | = SimpleResponse{_SimpleResponse'payload = Prelude.Nothing, 585 | _SimpleResponse'username = Data.ProtoLens.fieldDefault, 586 | _SimpleResponse'oauthScope = Data.ProtoLens.fieldDefault} 587 | 588 | instance Data.ProtoLens.Message SimpleResponse where 589 | descriptor 590 | = let payload__field_descriptor 591 | = Data.ProtoLens.FieldDescriptor "payload" 592 | (Data.ProtoLens.MessageField :: 593 | Data.ProtoLens.FieldTypeDescriptor Payload) 594 | (Data.ProtoLens.OptionalField maybe'payload) 595 | username__field_descriptor 596 | = Data.ProtoLens.FieldDescriptor "username" 597 | (Data.ProtoLens.StringField :: 598 | Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) 599 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional username) 600 | oauthScope__field_descriptor 601 | = Data.ProtoLens.FieldDescriptor "oauth_scope" 602 | (Data.ProtoLens.StringField :: 603 | Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) 604 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional oauthScope) 605 | in 606 | Data.ProtoLens.MessageDescriptor 607 | (Data.Map.fromList 608 | [(Data.ProtoLens.Tag 1, payload__field_descriptor), 609 | (Data.ProtoLens.Tag 2, username__field_descriptor), 610 | (Data.ProtoLens.Tag 3, oauthScope__field_descriptor)]) 611 | (Data.Map.fromList 612 | [("payload", payload__field_descriptor), 613 | ("username", username__field_descriptor), 614 | ("oauth_scope", oauthScope__field_descriptor)]) 615 | 616 | data StreamingInputCallRequest = StreamingInputCallRequest{_StreamingInputCallRequest'payload 617 | :: Prelude.Maybe Payload, 618 | _StreamingInputCallRequest'expectCompressed 619 | :: Prelude.Maybe BoolValue} 620 | deriving (Prelude.Show, Prelude.Eq) 621 | 622 | type instance 623 | Data.ProtoLens.Field "payload" StreamingInputCallRequest = Payload 624 | 625 | instance Data.ProtoLens.HasField "payload" 626 | StreamingInputCallRequest StreamingInputCallRequest where 627 | field _ 628 | = (Prelude..) maybe'payload 629 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 630 | 631 | type instance 632 | Data.ProtoLens.Field "maybe'payload" StreamingInputCallRequest = 633 | Prelude.Maybe Payload 634 | 635 | instance Data.ProtoLens.HasField "maybe'payload" 636 | StreamingInputCallRequest StreamingInputCallRequest where 637 | field _ 638 | = Lens.Family2.Unchecked.lens _StreamingInputCallRequest'payload 639 | (\ x__ y__ -> x__{_StreamingInputCallRequest'payload = y__}) 640 | 641 | type instance 642 | Data.ProtoLens.Field "expectCompressed" StreamingInputCallRequest = 643 | BoolValue 644 | 645 | instance Data.ProtoLens.HasField "expectCompressed" 646 | StreamingInputCallRequest StreamingInputCallRequest where 647 | field _ 648 | = (Prelude..) maybe'expectCompressed 649 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 650 | 651 | type instance 652 | Data.ProtoLens.Field "maybe'expectCompressed" 653 | StreamingInputCallRequest 654 | = Prelude.Maybe BoolValue 655 | 656 | instance Data.ProtoLens.HasField "maybe'expectCompressed" 657 | StreamingInputCallRequest StreamingInputCallRequest where 658 | field _ 659 | = Lens.Family2.Unchecked.lens 660 | _StreamingInputCallRequest'expectCompressed 661 | (\ x__ y__ -> 662 | x__{_StreamingInputCallRequest'expectCompressed = y__}) 663 | 664 | instance Data.Default.Class.Default StreamingInputCallRequest where 665 | def 666 | = StreamingInputCallRequest{_StreamingInputCallRequest'payload = 667 | Prelude.Nothing, 668 | _StreamingInputCallRequest'expectCompressed = Prelude.Nothing} 669 | 670 | instance Data.ProtoLens.Message StreamingInputCallRequest where 671 | descriptor 672 | = let payload__field_descriptor 673 | = Data.ProtoLens.FieldDescriptor "payload" 674 | (Data.ProtoLens.MessageField :: 675 | Data.ProtoLens.FieldTypeDescriptor Payload) 676 | (Data.ProtoLens.OptionalField maybe'payload) 677 | expectCompressed__field_descriptor 678 | = Data.ProtoLens.FieldDescriptor "expect_compressed" 679 | (Data.ProtoLens.MessageField :: 680 | Data.ProtoLens.FieldTypeDescriptor BoolValue) 681 | (Data.ProtoLens.OptionalField maybe'expectCompressed) 682 | in 683 | Data.ProtoLens.MessageDescriptor 684 | (Data.Map.fromList 685 | [(Data.ProtoLens.Tag 1, payload__field_descriptor), 686 | (Data.ProtoLens.Tag 2, expectCompressed__field_descriptor)]) 687 | (Data.Map.fromList 688 | [("payload", payload__field_descriptor), 689 | ("expect_compressed", expectCompressed__field_descriptor)]) 690 | 691 | data StreamingInputCallResponse = StreamingInputCallResponse{_StreamingInputCallResponse'aggregatedPayloadSize 692 | :: Data.Int.Int32} 693 | deriving (Prelude.Show, Prelude.Eq) 694 | 695 | type instance 696 | Data.ProtoLens.Field "aggregatedPayloadSize" 697 | StreamingInputCallResponse 698 | = Data.Int.Int32 699 | 700 | instance Data.ProtoLens.HasField "aggregatedPayloadSize" 701 | StreamingInputCallResponse StreamingInputCallResponse where 702 | field _ 703 | = Lens.Family2.Unchecked.lens 704 | _StreamingInputCallResponse'aggregatedPayloadSize 705 | (\ x__ y__ -> 706 | x__{_StreamingInputCallResponse'aggregatedPayloadSize = y__}) 707 | 708 | instance Data.Default.Class.Default StreamingInputCallResponse 709 | where 710 | def 711 | = StreamingInputCallResponse{_StreamingInputCallResponse'aggregatedPayloadSize 712 | = Data.ProtoLens.fieldDefault} 713 | 714 | instance Data.ProtoLens.Message StreamingInputCallResponse where 715 | descriptor 716 | = let aggregatedPayloadSize__field_descriptor 717 | = Data.ProtoLens.FieldDescriptor "aggregated_payload_size" 718 | (Data.ProtoLens.Int32Field :: 719 | Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) 720 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional 721 | aggregatedPayloadSize) 722 | in 723 | Data.ProtoLens.MessageDescriptor 724 | (Data.Map.fromList 725 | [(Data.ProtoLens.Tag 1, aggregatedPayloadSize__field_descriptor)]) 726 | (Data.Map.fromList 727 | [("aggregated_payload_size", 728 | aggregatedPayloadSize__field_descriptor)]) 729 | 730 | data StreamingOutputCallRequest = StreamingOutputCallRequest{_StreamingOutputCallRequest'responseType 731 | :: PayloadType, 732 | _StreamingOutputCallRequest'responseParameters 733 | :: [ResponseParameters], 734 | _StreamingOutputCallRequest'payload :: 735 | Prelude.Maybe Payload, 736 | _StreamingOutputCallRequest'responseStatus 737 | :: Prelude.Maybe EchoStatus} 738 | deriving (Prelude.Show, Prelude.Eq) 739 | 740 | type instance 741 | Data.ProtoLens.Field "responseType" StreamingOutputCallRequest = 742 | PayloadType 743 | 744 | instance Data.ProtoLens.HasField "responseType" 745 | StreamingOutputCallRequest StreamingOutputCallRequest where 746 | field _ 747 | = Lens.Family2.Unchecked.lens 748 | _StreamingOutputCallRequest'responseType 749 | (\ x__ y__ -> x__{_StreamingOutputCallRequest'responseType = y__}) 750 | 751 | type instance 752 | Data.ProtoLens.Field "responseParameters" 753 | StreamingOutputCallRequest 754 | = [ResponseParameters] 755 | 756 | instance Data.ProtoLens.HasField "responseParameters" 757 | StreamingOutputCallRequest StreamingOutputCallRequest where 758 | field _ 759 | = Lens.Family2.Unchecked.lens 760 | _StreamingOutputCallRequest'responseParameters 761 | (\ x__ y__ -> 762 | x__{_StreamingOutputCallRequest'responseParameters = y__}) 763 | 764 | type instance 765 | Data.ProtoLens.Field "payload" StreamingOutputCallRequest = Payload 766 | 767 | instance Data.ProtoLens.HasField "payload" 768 | StreamingOutputCallRequest StreamingOutputCallRequest where 769 | field _ 770 | = (Prelude..) maybe'payload 771 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 772 | 773 | type instance 774 | Data.ProtoLens.Field "maybe'payload" StreamingOutputCallRequest = 775 | Prelude.Maybe Payload 776 | 777 | instance Data.ProtoLens.HasField "maybe'payload" 778 | StreamingOutputCallRequest StreamingOutputCallRequest where 779 | field _ 780 | = Lens.Family2.Unchecked.lens _StreamingOutputCallRequest'payload 781 | (\ x__ y__ -> x__{_StreamingOutputCallRequest'payload = y__}) 782 | 783 | type instance 784 | Data.ProtoLens.Field "responseStatus" StreamingOutputCallRequest = 785 | EchoStatus 786 | 787 | instance Data.ProtoLens.HasField "responseStatus" 788 | StreamingOutputCallRequest StreamingOutputCallRequest where 789 | field _ 790 | = (Prelude..) maybe'responseStatus 791 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 792 | 793 | type instance 794 | Data.ProtoLens.Field "maybe'responseStatus" 795 | StreamingOutputCallRequest 796 | = Prelude.Maybe EchoStatus 797 | 798 | instance Data.ProtoLens.HasField "maybe'responseStatus" 799 | StreamingOutputCallRequest StreamingOutputCallRequest where 800 | field _ 801 | = Lens.Family2.Unchecked.lens 802 | _StreamingOutputCallRequest'responseStatus 803 | (\ x__ y__ -> 804 | x__{_StreamingOutputCallRequest'responseStatus = y__}) 805 | 806 | instance Data.Default.Class.Default StreamingOutputCallRequest 807 | where 808 | def 809 | = StreamingOutputCallRequest{_StreamingOutputCallRequest'responseType 810 | = Data.Default.Class.def, 811 | _StreamingOutputCallRequest'responseParameters = [], 812 | _StreamingOutputCallRequest'payload = Prelude.Nothing, 813 | _StreamingOutputCallRequest'responseStatus = Prelude.Nothing} 814 | 815 | instance Data.ProtoLens.Message StreamingOutputCallRequest where 816 | descriptor 817 | = let responseType__field_descriptor 818 | = Data.ProtoLens.FieldDescriptor "response_type" 819 | (Data.ProtoLens.EnumField :: 820 | Data.ProtoLens.FieldTypeDescriptor PayloadType) 821 | (Data.ProtoLens.PlainField Data.ProtoLens.Optional responseType) 822 | responseParameters__field_descriptor 823 | = Data.ProtoLens.FieldDescriptor "response_parameters" 824 | (Data.ProtoLens.MessageField :: 825 | Data.ProtoLens.FieldTypeDescriptor ResponseParameters) 826 | (Data.ProtoLens.RepeatedField Data.ProtoLens.Unpacked 827 | responseParameters) 828 | payload__field_descriptor 829 | = Data.ProtoLens.FieldDescriptor "payload" 830 | (Data.ProtoLens.MessageField :: 831 | Data.ProtoLens.FieldTypeDescriptor Payload) 832 | (Data.ProtoLens.OptionalField maybe'payload) 833 | responseStatus__field_descriptor 834 | = Data.ProtoLens.FieldDescriptor "response_status" 835 | (Data.ProtoLens.MessageField :: 836 | Data.ProtoLens.FieldTypeDescriptor EchoStatus) 837 | (Data.ProtoLens.OptionalField maybe'responseStatus) 838 | in 839 | Data.ProtoLens.MessageDescriptor 840 | (Data.Map.fromList 841 | [(Data.ProtoLens.Tag 1, responseType__field_descriptor), 842 | (Data.ProtoLens.Tag 2, responseParameters__field_descriptor), 843 | (Data.ProtoLens.Tag 3, payload__field_descriptor), 844 | (Data.ProtoLens.Tag 7, responseStatus__field_descriptor)]) 845 | (Data.Map.fromList 846 | [("response_type", responseType__field_descriptor), 847 | ("response_parameters", responseParameters__field_descriptor), 848 | ("payload", payload__field_descriptor), 849 | ("response_status", responseStatus__field_descriptor)]) 850 | 851 | data StreamingOutputCallResponse = StreamingOutputCallResponse{_StreamingOutputCallResponse'payload 852 | :: Prelude.Maybe Payload} 853 | deriving (Prelude.Show, Prelude.Eq) 854 | 855 | type instance 856 | Data.ProtoLens.Field "payload" StreamingOutputCallResponse = 857 | Payload 858 | 859 | instance Data.ProtoLens.HasField "payload" 860 | StreamingOutputCallResponse StreamingOutputCallResponse where 861 | field _ 862 | = (Prelude..) maybe'payload 863 | (Data.ProtoLens.maybeLens Data.Default.Class.def) 864 | 865 | type instance 866 | Data.ProtoLens.Field "maybe'payload" StreamingOutputCallResponse = 867 | Prelude.Maybe Payload 868 | 869 | instance Data.ProtoLens.HasField "maybe'payload" 870 | StreamingOutputCallResponse StreamingOutputCallResponse where 871 | field _ 872 | = Lens.Family2.Unchecked.lens _StreamingOutputCallResponse'payload 873 | (\ x__ y__ -> x__{_StreamingOutputCallResponse'payload = y__}) 874 | 875 | instance Data.Default.Class.Default StreamingOutputCallResponse 876 | where 877 | def 878 | = StreamingOutputCallResponse{_StreamingOutputCallResponse'payload 879 | = Prelude.Nothing} 880 | 881 | instance Data.ProtoLens.Message StreamingOutputCallResponse where 882 | descriptor 883 | = let payload__field_descriptor 884 | = Data.ProtoLens.FieldDescriptor "payload" 885 | (Data.ProtoLens.MessageField :: 886 | Data.ProtoLens.FieldTypeDescriptor Payload) 887 | (Data.ProtoLens.OptionalField maybe'payload) 888 | in 889 | Data.ProtoLens.MessageDescriptor 890 | (Data.Map.fromList 891 | [(Data.ProtoLens.Tag 1, payload__field_descriptor)]) 892 | (Data.Map.fromList [("payload", payload__field_descriptor)]) 893 | 894 | aggregatedPayloadSize :: 895 | forall msg msg' . 896 | Data.ProtoLens.HasField "aggregatedPayloadSize" msg msg' => 897 | Lens.Family2.Lens msg msg' 898 | (Data.ProtoLens.Field "aggregatedPayloadSize" msg) 899 | (Data.ProtoLens.Field "aggregatedPayloadSize" msg') 900 | aggregatedPayloadSize 901 | = Data.ProtoLens.field 902 | (Data.ProtoLens.ProxySym :: 903 | Data.ProtoLens.ProxySym "aggregatedPayloadSize") 904 | 905 | backoffMs :: 906 | forall msg msg' . Data.ProtoLens.HasField "backoffMs" msg msg' => 907 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "backoffMs" msg) 908 | (Data.ProtoLens.Field "backoffMs" msg') 909 | backoffMs 910 | = Data.ProtoLens.field 911 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "backoffMs") 912 | 913 | body :: 914 | forall msg msg' . Data.ProtoLens.HasField "body" msg msg' => 915 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "body" msg) 916 | (Data.ProtoLens.Field "body" msg') 917 | body 918 | = Data.ProtoLens.field 919 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "body") 920 | 921 | code :: 922 | forall msg msg' . Data.ProtoLens.HasField "code" msg msg' => 923 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "code" msg) 924 | (Data.ProtoLens.Field "code" msg') 925 | code 926 | = Data.ProtoLens.field 927 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "code") 928 | 929 | compressed :: 930 | forall msg msg' . Data.ProtoLens.HasField "compressed" msg msg' => 931 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "compressed" msg) 932 | (Data.ProtoLens.Field "compressed" msg') 933 | compressed 934 | = Data.ProtoLens.field 935 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "compressed") 936 | 937 | expectCompressed :: 938 | forall msg msg' . 939 | Data.ProtoLens.HasField "expectCompressed" msg msg' => 940 | Lens.Family2.Lens msg msg' 941 | (Data.ProtoLens.Field "expectCompressed" msg) 942 | (Data.ProtoLens.Field "expectCompressed" msg') 943 | expectCompressed 944 | = Data.ProtoLens.field 945 | (Data.ProtoLens.ProxySym :: 946 | Data.ProtoLens.ProxySym "expectCompressed") 947 | 948 | fillOauthScope :: 949 | forall msg msg' . 950 | Data.ProtoLens.HasField "fillOauthScope" msg msg' => 951 | Lens.Family2.Lens msg msg' 952 | (Data.ProtoLens.Field "fillOauthScope" msg) 953 | (Data.ProtoLens.Field "fillOauthScope" msg') 954 | fillOauthScope 955 | = Data.ProtoLens.field 956 | (Data.ProtoLens.ProxySym :: 957 | Data.ProtoLens.ProxySym "fillOauthScope") 958 | 959 | fillUsername :: 960 | forall msg msg' . 961 | Data.ProtoLens.HasField "fillUsername" msg msg' => 962 | Lens.Family2.Lens msg msg' 963 | (Data.ProtoLens.Field "fillUsername" msg) 964 | (Data.ProtoLens.Field "fillUsername" msg') 965 | fillUsername 966 | = Data.ProtoLens.field 967 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "fillUsername") 968 | 969 | intervalUs :: 970 | forall msg msg' . Data.ProtoLens.HasField "intervalUs" msg msg' => 971 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "intervalUs" msg) 972 | (Data.ProtoLens.Field "intervalUs" msg') 973 | intervalUs 974 | = Data.ProtoLens.field 975 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "intervalUs") 976 | 977 | maxReconnectBackoffMs :: 978 | forall msg msg' . 979 | Data.ProtoLens.HasField "maxReconnectBackoffMs" msg msg' => 980 | Lens.Family2.Lens msg msg' 981 | (Data.ProtoLens.Field "maxReconnectBackoffMs" msg) 982 | (Data.ProtoLens.Field "maxReconnectBackoffMs" msg') 983 | maxReconnectBackoffMs 984 | = Data.ProtoLens.field 985 | (Data.ProtoLens.ProxySym :: 986 | Data.ProtoLens.ProxySym "maxReconnectBackoffMs") 987 | 988 | maybe'compressed :: 989 | forall msg msg' . 990 | Data.ProtoLens.HasField "maybe'compressed" msg msg' => 991 | Lens.Family2.Lens msg msg' 992 | (Data.ProtoLens.Field "maybe'compressed" msg) 993 | (Data.ProtoLens.Field "maybe'compressed" msg') 994 | maybe'compressed 995 | = Data.ProtoLens.field 996 | (Data.ProtoLens.ProxySym :: 997 | Data.ProtoLens.ProxySym "maybe'compressed") 998 | 999 | maybe'expectCompressed :: 1000 | forall msg msg' . 1001 | Data.ProtoLens.HasField "maybe'expectCompressed" msg msg' => 1002 | Lens.Family2.Lens msg msg' 1003 | (Data.ProtoLens.Field "maybe'expectCompressed" msg) 1004 | (Data.ProtoLens.Field "maybe'expectCompressed" msg') 1005 | maybe'expectCompressed 1006 | = Data.ProtoLens.field 1007 | (Data.ProtoLens.ProxySym :: 1008 | Data.ProtoLens.ProxySym "maybe'expectCompressed") 1009 | 1010 | maybe'payload :: 1011 | forall msg msg' . 1012 | Data.ProtoLens.HasField "maybe'payload" msg msg' => 1013 | Lens.Family2.Lens msg msg' 1014 | (Data.ProtoLens.Field "maybe'payload" msg) 1015 | (Data.ProtoLens.Field "maybe'payload" msg') 1016 | maybe'payload 1017 | = Data.ProtoLens.field 1018 | (Data.ProtoLens.ProxySym :: 1019 | Data.ProtoLens.ProxySym "maybe'payload") 1020 | 1021 | maybe'responseCompressed :: 1022 | forall msg msg' . 1023 | Data.ProtoLens.HasField "maybe'responseCompressed" msg msg' => 1024 | Lens.Family2.Lens msg msg' 1025 | (Data.ProtoLens.Field "maybe'responseCompressed" msg) 1026 | (Data.ProtoLens.Field "maybe'responseCompressed" msg') 1027 | maybe'responseCompressed 1028 | = Data.ProtoLens.field 1029 | (Data.ProtoLens.ProxySym :: 1030 | Data.ProtoLens.ProxySym "maybe'responseCompressed") 1031 | 1032 | maybe'responseStatus :: 1033 | forall msg msg' . 1034 | Data.ProtoLens.HasField "maybe'responseStatus" msg msg' => 1035 | Lens.Family2.Lens msg msg' 1036 | (Data.ProtoLens.Field "maybe'responseStatus" msg) 1037 | (Data.ProtoLens.Field "maybe'responseStatus" msg') 1038 | maybe'responseStatus 1039 | = Data.ProtoLens.field 1040 | (Data.ProtoLens.ProxySym :: 1041 | Data.ProtoLens.ProxySym "maybe'responseStatus") 1042 | 1043 | message :: 1044 | forall msg msg' . Data.ProtoLens.HasField "message" msg msg' => 1045 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "message" msg) 1046 | (Data.ProtoLens.Field "message" msg') 1047 | message 1048 | = Data.ProtoLens.field 1049 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "message") 1050 | 1051 | oauthScope :: 1052 | forall msg msg' . Data.ProtoLens.HasField "oauthScope" msg msg' => 1053 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "oauthScope" msg) 1054 | (Data.ProtoLens.Field "oauthScope" msg') 1055 | oauthScope 1056 | = Data.ProtoLens.field 1057 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "oauthScope") 1058 | 1059 | passed :: 1060 | forall msg msg' . Data.ProtoLens.HasField "passed" msg msg' => 1061 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "passed" msg) 1062 | (Data.ProtoLens.Field "passed" msg') 1063 | passed 1064 | = Data.ProtoLens.field 1065 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "passed") 1066 | 1067 | payload :: 1068 | forall msg msg' . Data.ProtoLens.HasField "payload" msg msg' => 1069 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "payload" msg) 1070 | (Data.ProtoLens.Field "payload" msg') 1071 | payload 1072 | = Data.ProtoLens.field 1073 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "payload") 1074 | 1075 | responseCompressed :: 1076 | forall msg msg' . 1077 | Data.ProtoLens.HasField "responseCompressed" msg msg' => 1078 | Lens.Family2.Lens msg msg' 1079 | (Data.ProtoLens.Field "responseCompressed" msg) 1080 | (Data.ProtoLens.Field "responseCompressed" msg') 1081 | responseCompressed 1082 | = Data.ProtoLens.field 1083 | (Data.ProtoLens.ProxySym :: 1084 | Data.ProtoLens.ProxySym "responseCompressed") 1085 | 1086 | responseParameters :: 1087 | forall msg msg' . 1088 | Data.ProtoLens.HasField "responseParameters" msg msg' => 1089 | Lens.Family2.Lens msg msg' 1090 | (Data.ProtoLens.Field "responseParameters" msg) 1091 | (Data.ProtoLens.Field "responseParameters" msg') 1092 | responseParameters 1093 | = Data.ProtoLens.field 1094 | (Data.ProtoLens.ProxySym :: 1095 | Data.ProtoLens.ProxySym "responseParameters") 1096 | 1097 | responseSize :: 1098 | forall msg msg' . 1099 | Data.ProtoLens.HasField "responseSize" msg msg' => 1100 | Lens.Family2.Lens msg msg' 1101 | (Data.ProtoLens.Field "responseSize" msg) 1102 | (Data.ProtoLens.Field "responseSize" msg') 1103 | responseSize 1104 | = Data.ProtoLens.field 1105 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "responseSize") 1106 | 1107 | responseStatus :: 1108 | forall msg msg' . 1109 | Data.ProtoLens.HasField "responseStatus" msg msg' => 1110 | Lens.Family2.Lens msg msg' 1111 | (Data.ProtoLens.Field "responseStatus" msg) 1112 | (Data.ProtoLens.Field "responseStatus" msg') 1113 | responseStatus 1114 | = Data.ProtoLens.field 1115 | (Data.ProtoLens.ProxySym :: 1116 | Data.ProtoLens.ProxySym "responseStatus") 1117 | 1118 | responseType :: 1119 | forall msg msg' . 1120 | Data.ProtoLens.HasField "responseType" msg msg' => 1121 | Lens.Family2.Lens msg msg' 1122 | (Data.ProtoLens.Field "responseType" msg) 1123 | (Data.ProtoLens.Field "responseType" msg') 1124 | responseType 1125 | = Data.ProtoLens.field 1126 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "responseType") 1127 | 1128 | size :: 1129 | forall msg msg' . Data.ProtoLens.HasField "size" msg msg' => 1130 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "size" msg) 1131 | (Data.ProtoLens.Field "size" msg') 1132 | size 1133 | = Data.ProtoLens.field 1134 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "size") 1135 | 1136 | type' :: 1137 | forall msg msg' . Data.ProtoLens.HasField "type'" msg msg' => 1138 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "type'" msg) 1139 | (Data.ProtoLens.Field "type'" msg') 1140 | type' 1141 | = Data.ProtoLens.field 1142 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "type'") 1143 | 1144 | username :: 1145 | forall msg msg' . Data.ProtoLens.HasField "username" msg msg' => 1146 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "username" msg) 1147 | (Data.ProtoLens.Field "username" msg') 1148 | username 1149 | = Data.ProtoLens.field 1150 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "username") 1151 | 1152 | value :: 1153 | forall msg msg' . Data.ProtoLens.HasField "value" msg msg' => 1154 | Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "value" msg) 1155 | (Data.ProtoLens.Field "value" msg') 1156 | value 1157 | = Data.ProtoLens.field 1158 | (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "value") --------------------------------------------------------------------------------