diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for warp-grpc + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Lucas DiCioccio (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,82 @@ +# warp-grpc + +A gRPC server implementation on top of Warp's HTTP2 handler. The lib also +contains a demo sever using the awesome `grpcb.in` Proto. The current release +is an advanced technical demo, expect a few breaking changes. + +## Usage + +### Prerequisites + +In addition to a working Haskell dev environment, you need to: +- build the `proto-lens-protoc` executable (`proto-lens`) +- install the `protoc` executable + +### Adding .proto files to a Haskell package + +In order to run gRPC: + +- generate the `Proto` stubs in some `gen` directory + +A single `protoc` invocation may be enough for both Proto and GRPC outputs: + +```bash +protoc "--plugin=protoc-gen-haskell-protolens=${protolens}" \ + --haskell-protolens_out=./gen \ + -I "${protodir1} \ + -I "${protodir2} \ + ${first.proto} \ + ${second.proto} +``` + +- add the `gen` sourcedir for the generated to your .cabal/package.yaml file (cf. 'hs-source-dirs'). +- add the generated Proto modules to the 'exposed-modules' (or 'other-modules') keys + +A reliable way to list the module names is the following bash invocation: + +```bash +find gen -name "*.hs" | sed -e 's/gen\///' | sed -e 's/\.hs$//' | tr '/' '.' +``` + +Unlike `proto-lens`, this project does not yet provide a modified `Setup.hs`. +As a result, we cannot automate these steps from within Cabal/Stack. Hence, +you'll have to automate these steps outside your Haskell toolchain. + + +### Build a certificate + +In shell, + +```shell +openssl genrsa -out key.pem 2048 +openssl req -new -key key.pem -out certificate.csr +openssl x509 -req -in certificate.csr -signkey key.pem -out certificate.pem +``` + +### Build and run the example binary + +- stack build +- stack exec -- warp-grpc-exe + +Note that you'll need a patched Warp using https://github.com/yesodweb/wai/pull/711 . + +## Design + +The library implements gRPC using a WAI middleware for a set of gRPC endpoints. +Endpoint handlers differ depending of the streaming/unary-ty of individual +RPCs. Bidirectional streams will be supported next. + +There is little specification around the expected allowed observable states in +gRPC, hence the types this library presents make conservative choices: unary +RPCs expect an input before providing an output. Client stream allows to return +an output only when the client has stopped streaming. Server streams wait for +an input before starting to iterate sending outputs. + +## Next steps + +* Split the `grpcb.in` example from the lib. +* Handler type for bidirectional streams. + +## Limitations + +* Only supports "h2" with TLS (I'd argue it's a feature, not a bug. Don't @-me) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +module Main where + +import Network.GRPC.Server + +import Control.Concurrent (threadDelay) +import Data.ProtoLens.Message (def) +import Network.Wai.Handler.WarpTLS (defaultTlsSettings) +import Network.Wai.Handler.Warp (defaultSettings) +import Network.GRPC.HTTP2.Types (RPC(..)) +import Network.GRPC.HTTP2.Encoding (gzip) +import Proto.Protos.Grpcbin (GRPCBin, EmptyMessage(..), IndexReply(..), IndexReply'Endpoint(..)) + +main :: IO () +main = runGrpc defaultTlsSettings defaultSettings handlers [gzip] + +handlers :: [ServiceHandler] +handlers = + [ unary (RPC :: RPC GRPCBin "empty") handleEmpty + , unary (RPC :: RPC GRPCBin "index") handleIndex + , unary (RPC :: RPC GRPCBin "specificError") handleSpecificError + , unary (RPC :: RPC GRPCBin "randomError") handleRandomError + , unary (RPC :: RPC GRPCBin "dummyUnary") handleDummyUnary + , serverStream (RPC :: RPC GRPCBin "dummyServerStream") handleDummyServerStream + , clientStream (RPC :: RPC GRPCBin "dummyClientStream") handleDummyClientStream + ] + +handleIndex :: UnaryHandler GRPCBin "index" +handleIndex _ input = do + print ("index"::[Char], input) + return $ IndexReply "desc" [IndexReply'Endpoint "/path1" "ill-supported" def] def + +handleEmpty :: UnaryHandler GRPCBin "empty" +handleEmpty _ input = do + print ("empty"::[Char], input) + return $ EmptyMessage def + +handleSpecificError :: UnaryHandler GRPCBin "specificError" +handleSpecificError _ input = do + print ("specificError"::[Char], input) + _ <- throwIO $ GRPCStatus INTERNAL "noo" + return $ EmptyMessage def + +handleRandomError :: UnaryHandler GRPCBin "randomError" +handleRandomError _ input = do + print ("randomError"::[Char], input) + return $ EmptyMessage def + +handleDummyUnary :: UnaryHandler GRPCBin "dummyUnary" +handleDummyUnary _ input = pure input + +handleDummyServerStream :: ServerStreamHandler GRPCBin "dummyServerStream" Int +handleDummyServerStream _ input = do + print ("sstream-start"::[Char], input) + return $ (10, ServerStream $ \n -> do + threadDelay 1000000 + if n == 0 + then print ("sstream-end"::[Char]) >> return Nothing + else do + print ("sstream-msg"::[Char], n) + return $ Just (n-1, def)) + +handleDummyClientStream :: ClientStreamHandler GRPCBin "dummyClientStream" Int +handleDummyClientStream _ = do + print ("cstream-start"::[Char]) + return $ (0, ClientStream + (\n input -> print ("cstream-msg"::[Char], n, input) >> return (n+1)) + (\n -> print ("cstream-end"::[Char], n) >> return def)) diff --git a/gen/Proto/Protos/Grpcbin.hs b/gen/Proto/Protos/Grpcbin.hs new file mode 100644 --- /dev/null +++ b/gen/Proto/Protos/Grpcbin.hs @@ -0,0 +1,986 @@ +{- This file was auto-generated from protos/grpcbin.proto by the proto-lens-protoc program. -} +{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, + UndecidableInstances, GeneralizedNewtypeDeriving, + MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, + PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds #-} +{-# OPTIONS_GHC -fno-warn-unused-imports#-} +{-# OPTIONS_GHC -fno-warn-duplicate-exports#-} +module Proto.Protos.Grpcbin + (GRPCBin(..), DummyMessage(..), DummyMessage'Enum(..), + DummyMessage'Enum(), DummyMessage'Enum'UnrecognizedValue, + DummyMessage'Sub(..), EmptyMessage(..), HeadersMessage(..), + HeadersMessage'MetadataEntry(..), HeadersMessage'Values(..), + IndexReply(..), IndexReply'Endpoint(..), SpecificErrorRequest(..)) + where +import qualified Data.ProtoLens.Reexport.Lens.Labels.Prism + as Lens.Labels.Prism +import qualified Data.ProtoLens.Reexport.Prelude as Prelude +import qualified Data.ProtoLens.Reexport.Data.Int as Data.Int +import qualified Data.ProtoLens.Reexport.Data.Word as Data.Word +import qualified Data.ProtoLens.Reexport.Data.ProtoLens + as Data.ProtoLens +import qualified + Data.ProtoLens.Reexport.Data.ProtoLens.Message.Enum + as Data.ProtoLens.Message.Enum +import qualified + Data.ProtoLens.Reexport.Data.ProtoLens.Service.Types + as Data.ProtoLens.Service.Types +import qualified Data.ProtoLens.Reexport.Lens.Family2 + as Lens.Family2 +import qualified Data.ProtoLens.Reexport.Lens.Family2.Unchecked + as Lens.Family2.Unchecked +import qualified Data.ProtoLens.Reexport.Data.Default.Class + as Data.Default.Class +import qualified Data.ProtoLens.Reexport.Data.Text as Data.Text +import qualified Data.ProtoLens.Reexport.Data.Map as Data.Map +import qualified Data.ProtoLens.Reexport.Data.ByteString + as Data.ByteString +import qualified Data.ProtoLens.Reexport.Data.ByteString.Char8 + as Data.ByteString.Char8 +import qualified Data.ProtoLens.Reexport.Lens.Labels as Lens.Labels +import qualified Data.ProtoLens.Reexport.Text.Read as Text.Read + +{- | Fields : + + * 'Proto.Protos.Grpcbin_Fields.fString' @:: Lens' DummyMessage Data.Text.Text@ + * 'Proto.Protos.Grpcbin_Fields.fStrings' @:: Lens' DummyMessage [Data.Text.Text]@ + * 'Proto.Protos.Grpcbin_Fields.fInt32' @:: Lens' DummyMessage Data.Int.Int32@ + * 'Proto.Protos.Grpcbin_Fields.fInt32s' @:: Lens' DummyMessage [Data.Int.Int32]@ + * 'Proto.Protos.Grpcbin_Fields.fEnum' @:: Lens' DummyMessage DummyMessage'Enum@ + * 'Proto.Protos.Grpcbin_Fields.fEnums' @:: Lens' DummyMessage [DummyMessage'Enum]@ + * 'Proto.Protos.Grpcbin_Fields.fSub' @:: Lens' DummyMessage DummyMessage'Sub@ + * 'Proto.Protos.Grpcbin_Fields.maybe'fSub' @:: Lens' DummyMessage (Prelude.Maybe DummyMessage'Sub)@ + * 'Proto.Protos.Grpcbin_Fields.fSubs' @:: Lens' DummyMessage [DummyMessage'Sub]@ + * 'Proto.Protos.Grpcbin_Fields.fBool' @:: Lens' DummyMessage Prelude.Bool@ + * 'Proto.Protos.Grpcbin_Fields.fBools' @:: Lens' DummyMessage [Prelude.Bool]@ + * 'Proto.Protos.Grpcbin_Fields.fInt64' @:: Lens' DummyMessage Data.Int.Int64@ + * 'Proto.Protos.Grpcbin_Fields.fInt64s' @:: Lens' DummyMessage [Data.Int.Int64]@ + * 'Proto.Protos.Grpcbin_Fields.fBytes' @:: Lens' DummyMessage Data.ByteString.ByteString@ + * 'Proto.Protos.Grpcbin_Fields.fBytess' @:: Lens' DummyMessage [Data.ByteString.ByteString]@ + * 'Proto.Protos.Grpcbin_Fields.fFloat' @:: Lens' DummyMessage Prelude.Float@ + * 'Proto.Protos.Grpcbin_Fields.fFloats' @:: Lens' DummyMessage [Prelude.Float]@ + -} +data DummyMessage = DummyMessage{_DummyMessage'fString :: + !Data.Text.Text, + _DummyMessage'fStrings :: ![Data.Text.Text], + _DummyMessage'fInt32 :: !Data.Int.Int32, + _DummyMessage'fInt32s :: ![Data.Int.Int32], + _DummyMessage'fEnum :: !DummyMessage'Enum, + _DummyMessage'fEnums :: ![DummyMessage'Enum], + _DummyMessage'fSub :: !(Prelude.Maybe DummyMessage'Sub), + _DummyMessage'fSubs :: ![DummyMessage'Sub], + _DummyMessage'fBool :: !Prelude.Bool, + _DummyMessage'fBools :: ![Prelude.Bool], + _DummyMessage'fInt64 :: !Data.Int.Int64, + _DummyMessage'fInt64s :: ![Data.Int.Int64], + _DummyMessage'fBytes :: !Data.ByteString.ByteString, + _DummyMessage'fBytess :: ![Data.ByteString.ByteString], + _DummyMessage'fFloat :: !Prelude.Float, + _DummyMessage'fFloats :: ![Prelude.Float], + _DummyMessage'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance (Lens.Labels.HasLens' f DummyMessage x a, a ~ b) => + Lens.Labels.HasLens f DummyMessage DummyMessage x a b + where + lensOf = Lens.Labels.lensOf' +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fString" (Data.Text.Text) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fString + (\ x__ y__ -> x__{_DummyMessage'fString = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fStrings" ([Data.Text.Text]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fStrings + (\ x__ y__ -> x__{_DummyMessage'fStrings = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fInt32" (Data.Int.Int32) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fInt32 + (\ x__ y__ -> x__{_DummyMessage'fInt32 = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fInt32s" ([Data.Int.Int32]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fInt32s + (\ x__ y__ -> x__{_DummyMessage'fInt32s = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fEnum" (DummyMessage'Enum) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fEnum + (\ x__ y__ -> x__{_DummyMessage'fEnum = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fEnums" ([DummyMessage'Enum]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fEnums + (\ x__ y__ -> x__{_DummyMessage'fEnums = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fSub" (DummyMessage'Sub) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fSub + (\ x__ y__ -> x__{_DummyMessage'fSub = y__})) + (Data.ProtoLens.maybeLens Data.Default.Class.def) +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "maybe'fSub" + (Prelude.Maybe DummyMessage'Sub) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fSub + (\ x__ y__ -> x__{_DummyMessage'fSub = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fSubs" ([DummyMessage'Sub]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fSubs + (\ x__ y__ -> x__{_DummyMessage'fSubs = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fBool" (Prelude.Bool) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fBool + (\ x__ y__ -> x__{_DummyMessage'fBool = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fBools" ([Prelude.Bool]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fBools + (\ x__ y__ -> x__{_DummyMessage'fBools = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fInt64" (Data.Int.Int64) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fInt64 + (\ x__ y__ -> x__{_DummyMessage'fInt64 = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fInt64s" ([Data.Int.Int64]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fInt64s + (\ x__ y__ -> x__{_DummyMessage'fInt64s = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fBytes" + (Data.ByteString.ByteString) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fBytes + (\ x__ y__ -> x__{_DummyMessage'fBytes = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fBytess" + ([Data.ByteString.ByteString]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fBytess + (\ x__ y__ -> x__{_DummyMessage'fBytess = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fFloat" (Prelude.Float) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fFloat + (\ x__ y__ -> x__{_DummyMessage'fFloat = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage "fFloats" ([Prelude.Float]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'fFloats + (\ x__ y__ -> x__{_DummyMessage'fFloats = y__})) + Prelude.id +instance Data.Default.Class.Default DummyMessage where + def + = DummyMessage{_DummyMessage'fString = Data.ProtoLens.fieldDefault, + _DummyMessage'fStrings = [], + _DummyMessage'fInt32 = Data.ProtoLens.fieldDefault, + _DummyMessage'fInt32s = [], + _DummyMessage'fEnum = Data.Default.Class.def, + _DummyMessage'fEnums = [], _DummyMessage'fSub = Prelude.Nothing, + _DummyMessage'fSubs = [], + _DummyMessage'fBool = Data.ProtoLens.fieldDefault, + _DummyMessage'fBools = [], + _DummyMessage'fInt64 = Data.ProtoLens.fieldDefault, + _DummyMessage'fInt64s = [], + _DummyMessage'fBytes = Data.ProtoLens.fieldDefault, + _DummyMessage'fBytess = [], + _DummyMessage'fFloat = Data.ProtoLens.fieldDefault, + _DummyMessage'fFloats = [], _DummyMessage'_unknownFields = ([])} +instance Data.ProtoLens.Message DummyMessage where + messageName _ = Data.Text.pack "grpcbin.DummyMessage" + fieldsByTag + = let fString__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_string" + (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: + Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fString"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fStrings__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_strings" + (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: + Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Unpacked + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fStrings"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fInt32__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_int32" + (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fInt32"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fInt32s__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_int32s" + (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Packed + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fInt32s"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fEnum__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_enum" + (Data.ProtoLens.ScalarField Data.ProtoLens.EnumField :: + Data.ProtoLens.FieldTypeDescriptor DummyMessage'Enum) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fEnum"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fEnums__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_enums" + (Data.ProtoLens.ScalarField Data.ProtoLens.EnumField :: + Data.ProtoLens.FieldTypeDescriptor DummyMessage'Enum) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Packed + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fEnums"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fSub__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_sub" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor DummyMessage'Sub) + (Data.ProtoLens.OptionalField + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'fSub"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fSubs__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_subs" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor DummyMessage'Sub) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Unpacked + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fSubs"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fBool__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_bool" + (Data.ProtoLens.ScalarField Data.ProtoLens.BoolField :: + Data.ProtoLens.FieldTypeDescriptor Prelude.Bool) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fBool"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fBools__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_bools" + (Data.ProtoLens.ScalarField Data.ProtoLens.BoolField :: + Data.ProtoLens.FieldTypeDescriptor Prelude.Bool) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Packed + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fBools"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fInt64__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_int64" + (Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fInt64"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fInt64s__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_int64s" + (Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Packed + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fInt64s"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fBytes__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_bytes" + (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: + Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fBytes"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fBytess__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_bytess" + (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField :: + Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Unpacked + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fBytess"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fFloat__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_float" + (Data.ProtoLens.ScalarField Data.ProtoLens.FloatField :: + Data.ProtoLens.FieldTypeDescriptor Prelude.Float) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fFloat"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + fFloats__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_floats" + (Data.ProtoLens.ScalarField Data.ProtoLens.FloatField :: + Data.ProtoLens.FieldTypeDescriptor Prelude.Float) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Packed + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fFloats"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, fString__field_descriptor), + (Data.ProtoLens.Tag 2, fStrings__field_descriptor), + (Data.ProtoLens.Tag 3, fInt32__field_descriptor), + (Data.ProtoLens.Tag 4, fInt32s__field_descriptor), + (Data.ProtoLens.Tag 5, fEnum__field_descriptor), + (Data.ProtoLens.Tag 6, fEnums__field_descriptor), + (Data.ProtoLens.Tag 7, fSub__field_descriptor), + (Data.ProtoLens.Tag 8, fSubs__field_descriptor), + (Data.ProtoLens.Tag 9, fBool__field_descriptor), + (Data.ProtoLens.Tag 10, fBools__field_descriptor), + (Data.ProtoLens.Tag 11, fInt64__field_descriptor), + (Data.ProtoLens.Tag 12, fInt64s__field_descriptor), + (Data.ProtoLens.Tag 13, fBytes__field_descriptor), + (Data.ProtoLens.Tag 14, fBytess__field_descriptor), + (Data.ProtoLens.Tag 15, fFloat__field_descriptor), + (Data.ProtoLens.Tag 16, fFloats__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens _DummyMessage'_unknownFields + (\ x__ y__ -> x__{_DummyMessage'_unknownFields = y__}) +data DummyMessage'Enum = DummyMessage'ENUM_0 + | DummyMessage'ENUM_1 + | DummyMessage'ENUM_2 + | DummyMessage'Enum'Unrecognized !DummyMessage'Enum'UnrecognizedValue + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +newtype DummyMessage'Enum'UnrecognizedValue = DummyMessage'Enum'UnrecognizedValue Data.Int.Int32 + deriving (Prelude.Eq, Prelude.Ord, Prelude.Show) +instance Data.ProtoLens.MessageEnum DummyMessage'Enum where + maybeToEnum 0 = Prelude.Just DummyMessage'ENUM_0 + maybeToEnum 1 = Prelude.Just DummyMessage'ENUM_1 + maybeToEnum 2 = Prelude.Just DummyMessage'ENUM_2 + maybeToEnum k + = Prelude.Just + (DummyMessage'Enum'Unrecognized + (DummyMessage'Enum'UnrecognizedValue (Prelude.fromIntegral k))) + showEnum DummyMessage'ENUM_0 = "ENUM_0" + showEnum DummyMessage'ENUM_1 = "ENUM_1" + showEnum DummyMessage'ENUM_2 = "ENUM_2" + showEnum + (DummyMessage'Enum'Unrecognized + (DummyMessage'Enum'UnrecognizedValue k)) + = Prelude.show k + readEnum "ENUM_0" = Prelude.Just DummyMessage'ENUM_0 + readEnum "ENUM_1" = Prelude.Just DummyMessage'ENUM_1 + readEnum "ENUM_2" = Prelude.Just DummyMessage'ENUM_2 + readEnum k + = (Prelude.>>=) (Text.Read.readMaybe k) Data.ProtoLens.maybeToEnum +instance Prelude.Bounded DummyMessage'Enum where + minBound = DummyMessage'ENUM_0 + maxBound = DummyMessage'ENUM_2 +instance Prelude.Enum DummyMessage'Enum where + toEnum k__ + = Prelude.maybe + (Prelude.error + ((Prelude.++) "toEnum: unknown value for enum Enum: " + (Prelude.show k__))) + Prelude.id + (Data.ProtoLens.maybeToEnum k__) + fromEnum DummyMessage'ENUM_0 = 0 + fromEnum DummyMessage'ENUM_1 = 1 + fromEnum DummyMessage'ENUM_2 = 2 + fromEnum + (DummyMessage'Enum'Unrecognized + (DummyMessage'Enum'UnrecognizedValue k)) + = Prelude.fromIntegral k + succ DummyMessage'ENUM_2 + = Prelude.error + "DummyMessage'Enum.succ: bad argument DummyMessage'ENUM_2. This value would be out of bounds." + succ DummyMessage'ENUM_0 = DummyMessage'ENUM_1 + succ DummyMessage'ENUM_1 = DummyMessage'ENUM_2 + succ _ + = Prelude.error + "DummyMessage'Enum.succ: bad argument: unrecognized value" + pred DummyMessage'ENUM_0 + = Prelude.error + "DummyMessage'Enum.pred: bad argument DummyMessage'ENUM_0. This value would be out of bounds." + pred DummyMessage'ENUM_1 = DummyMessage'ENUM_0 + pred DummyMessage'ENUM_2 = DummyMessage'ENUM_1 + pred _ + = Prelude.error + "DummyMessage'Enum.pred: bad argument: unrecognized value" + enumFrom = Data.ProtoLens.Message.Enum.messageEnumFrom + enumFromTo = Data.ProtoLens.Message.Enum.messageEnumFromTo + enumFromThen = Data.ProtoLens.Message.Enum.messageEnumFromThen + enumFromThenTo = Data.ProtoLens.Message.Enum.messageEnumFromThenTo +instance Data.Default.Class.Default DummyMessage'Enum where + def = DummyMessage'ENUM_0 +instance Data.ProtoLens.FieldDefault DummyMessage'Enum where + fieldDefault = DummyMessage'ENUM_0 +{- | Fields : + + * 'Proto.Protos.Grpcbin_Fields.fString' @:: Lens' DummyMessage'Sub Data.Text.Text@ + -} +data DummyMessage'Sub = DummyMessage'Sub{_DummyMessage'Sub'fString + :: !Data.Text.Text, + _DummyMessage'Sub'_unknownFields :: + !Data.ProtoLens.FieldSet} + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance (Lens.Labels.HasLens' f DummyMessage'Sub x a, a ~ b) => + Lens.Labels.HasLens f DummyMessage'Sub DummyMessage'Sub x a b + where + lensOf = Lens.Labels.lensOf' +instance Prelude.Functor f => + Lens.Labels.HasLens' f DummyMessage'Sub "fString" (Data.Text.Text) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _DummyMessage'Sub'fString + (\ x__ y__ -> x__{_DummyMessage'Sub'fString = y__})) + Prelude.id +instance Data.Default.Class.Default DummyMessage'Sub where + def + = DummyMessage'Sub{_DummyMessage'Sub'fString = + Data.ProtoLens.fieldDefault, + _DummyMessage'Sub'_unknownFields = ([])} +instance Data.ProtoLens.Message DummyMessage'Sub where + messageName _ = Data.Text.pack "grpcbin.DummyMessage.Sub" + fieldsByTag + = let fString__field_descriptor + = Data.ProtoLens.FieldDescriptor "f_string" + (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: + Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fString"))) + :: Data.ProtoLens.FieldDescriptor DummyMessage'Sub + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, fString__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens _DummyMessage'Sub'_unknownFields + (\ x__ y__ -> x__{_DummyMessage'Sub'_unknownFields = y__}) +{- | Fields : + + -} +data EmptyMessage = EmptyMessage{_EmptyMessage'_unknownFields :: + !Data.ProtoLens.FieldSet} + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance (Lens.Labels.HasLens' f EmptyMessage x a, a ~ b) => + Lens.Labels.HasLens f EmptyMessage EmptyMessage x a b + where + lensOf = Lens.Labels.lensOf' +instance Data.Default.Class.Default EmptyMessage where + def = EmptyMessage{_EmptyMessage'_unknownFields = ([])} +instance Data.ProtoLens.Message EmptyMessage where + messageName _ = Data.Text.pack "grpcbin.EmptyMessage" + fieldsByTag = let in Data.Map.fromList [] + unknownFields + = Lens.Family2.Unchecked.lens _EmptyMessage'_unknownFields + (\ x__ y__ -> x__{_EmptyMessage'_unknownFields = y__}) +{- | Fields : + + * 'Proto.Protos.Grpcbin_Fields.metadata' @:: Lens' HeadersMessage + (Data.Map.Map Data.Text.Text HeadersMessage'Values)@ + -} +data HeadersMessage = HeadersMessage{_HeadersMessage'metadata :: + !(Data.Map.Map Data.Text.Text HeadersMessage'Values), + _HeadersMessage'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance (Lens.Labels.HasLens' f HeadersMessage x a, a ~ b) => + Lens.Labels.HasLens f HeadersMessage HeadersMessage x a b + where + lensOf = Lens.Labels.lensOf' +instance Prelude.Functor f => + Lens.Labels.HasLens' f HeadersMessage "metadata" + (Data.Map.Map Data.Text.Text HeadersMessage'Values) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _HeadersMessage'metadata + (\ x__ y__ -> x__{_HeadersMessage'metadata = y__})) + Prelude.id +instance Data.Default.Class.Default HeadersMessage where + def + = HeadersMessage{_HeadersMessage'metadata = Data.Map.empty, + _HeadersMessage'_unknownFields = ([])} +instance Data.ProtoLens.Message HeadersMessage where + messageName _ = Data.Text.pack "grpcbin.HeadersMessage" + fieldsByTag + = let metadata__field_descriptor + = Data.ProtoLens.FieldDescriptor "Metadata" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor HeadersMessage'MetadataEntry) + (Data.ProtoLens.MapField + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "key")) + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "value")) + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "metadata"))) + :: Data.ProtoLens.FieldDescriptor HeadersMessage + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, metadata__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens _HeadersMessage'_unknownFields + (\ x__ y__ -> x__{_HeadersMessage'_unknownFields = y__}) +{- | Fields : + + * 'Proto.Protos.Grpcbin_Fields.key' @:: Lens' HeadersMessage'MetadataEntry Data.Text.Text@ + * 'Proto.Protos.Grpcbin_Fields.value' @:: Lens' HeadersMessage'MetadataEntry HeadersMessage'Values@ + * 'Proto.Protos.Grpcbin_Fields.maybe'value' @:: Lens' HeadersMessage'MetadataEntry + (Prelude.Maybe HeadersMessage'Values)@ + -} +data HeadersMessage'MetadataEntry = HeadersMessage'MetadataEntry{_HeadersMessage'MetadataEntry'key + :: !Data.Text.Text, + _HeadersMessage'MetadataEntry'value + :: + !(Prelude.Maybe + HeadersMessage'Values), + _HeadersMessage'MetadataEntry'_unknownFields + :: !Data.ProtoLens.FieldSet} + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance (Lens.Labels.HasLens' f HeadersMessage'MetadataEntry x a, + a ~ b) => + Lens.Labels.HasLens f HeadersMessage'MetadataEntry + HeadersMessage'MetadataEntry + x + a + b + where + lensOf = Lens.Labels.lensOf' +instance Prelude.Functor f => + Lens.Labels.HasLens' f HeadersMessage'MetadataEntry "key" + (Data.Text.Text) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _HeadersMessage'MetadataEntry'key + (\ x__ y__ -> x__{_HeadersMessage'MetadataEntry'key = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f HeadersMessage'MetadataEntry "value" + (HeadersMessage'Values) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _HeadersMessage'MetadataEntry'value + (\ x__ y__ -> x__{_HeadersMessage'MetadataEntry'value = y__})) + (Data.ProtoLens.maybeLens Data.Default.Class.def) +instance Prelude.Functor f => + Lens.Labels.HasLens' f HeadersMessage'MetadataEntry "maybe'value" + (Prelude.Maybe HeadersMessage'Values) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _HeadersMessage'MetadataEntry'value + (\ x__ y__ -> x__{_HeadersMessage'MetadataEntry'value = y__})) + Prelude.id +instance Data.Default.Class.Default HeadersMessage'MetadataEntry + where + def + = HeadersMessage'MetadataEntry{_HeadersMessage'MetadataEntry'key = + Data.ProtoLens.fieldDefault, + _HeadersMessage'MetadataEntry'value = Prelude.Nothing, + _HeadersMessage'MetadataEntry'_unknownFields = ([])} +instance Data.ProtoLens.Message HeadersMessage'MetadataEntry where + messageName _ + = Data.Text.pack "grpcbin.HeadersMessage.MetadataEntry" + fieldsByTag + = let key__field_descriptor + = Data.ProtoLens.FieldDescriptor "key" + (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: + Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "key"))) + :: Data.ProtoLens.FieldDescriptor HeadersMessage'MetadataEntry + value__field_descriptor + = Data.ProtoLens.FieldDescriptor "value" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor HeadersMessage'Values) + (Data.ProtoLens.OptionalField + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'value"))) + :: Data.ProtoLens.FieldDescriptor HeadersMessage'MetadataEntry + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, key__field_descriptor), + (Data.ProtoLens.Tag 2, value__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _HeadersMessage'MetadataEntry'_unknownFields + (\ x__ y__ -> + x__{_HeadersMessage'MetadataEntry'_unknownFields = y__}) +{- | Fields : + + * 'Proto.Protos.Grpcbin_Fields.values' @:: Lens' HeadersMessage'Values [Data.Text.Text]@ + -} +data HeadersMessage'Values = HeadersMessage'Values{_HeadersMessage'Values'values + :: ![Data.Text.Text], + _HeadersMessage'Values'_unknownFields :: + !Data.ProtoLens.FieldSet} + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance (Lens.Labels.HasLens' f HeadersMessage'Values x a, + a ~ b) => + Lens.Labels.HasLens f HeadersMessage'Values HeadersMessage'Values x + a + b + where + lensOf = Lens.Labels.lensOf' +instance Prelude.Functor f => + Lens.Labels.HasLens' f HeadersMessage'Values "values" + ([Data.Text.Text]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _HeadersMessage'Values'values + (\ x__ y__ -> x__{_HeadersMessage'Values'values = y__})) + Prelude.id +instance Data.Default.Class.Default HeadersMessage'Values where + def + = HeadersMessage'Values{_HeadersMessage'Values'values = [], + _HeadersMessage'Values'_unknownFields = ([])} +instance Data.ProtoLens.Message HeadersMessage'Values where + messageName _ = Data.Text.pack "grpcbin.HeadersMessage.Values" + fieldsByTag + = let values__field_descriptor + = Data.ProtoLens.FieldDescriptor "values" + (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: + Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Unpacked + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "values"))) + :: Data.ProtoLens.FieldDescriptor HeadersMessage'Values + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, values__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens _HeadersMessage'Values'_unknownFields + (\ x__ y__ -> x__{_HeadersMessage'Values'_unknownFields = y__}) +{- | Fields : + + * 'Proto.Protos.Grpcbin_Fields.description' @:: Lens' IndexReply Data.Text.Text@ + * 'Proto.Protos.Grpcbin_Fields.endpoints' @:: Lens' IndexReply [IndexReply'Endpoint]@ + -} +data IndexReply = IndexReply{_IndexReply'description :: + !Data.Text.Text, + _IndexReply'endpoints :: ![IndexReply'Endpoint], + _IndexReply'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance (Lens.Labels.HasLens' f IndexReply x a, a ~ b) => + Lens.Labels.HasLens f IndexReply IndexReply x a b + where + lensOf = Lens.Labels.lensOf' +instance Prelude.Functor f => + Lens.Labels.HasLens' f IndexReply "description" (Data.Text.Text) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _IndexReply'description + (\ x__ y__ -> x__{_IndexReply'description = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f IndexReply "endpoints" + ([IndexReply'Endpoint]) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _IndexReply'endpoints + (\ x__ y__ -> x__{_IndexReply'endpoints = y__})) + Prelude.id +instance Data.Default.Class.Default IndexReply where + def + = IndexReply{_IndexReply'description = Data.ProtoLens.fieldDefault, + _IndexReply'endpoints = [], _IndexReply'_unknownFields = ([])} +instance Data.ProtoLens.Message IndexReply where + messageName _ = Data.Text.pack "grpcbin.IndexReply" + fieldsByTag + = let description__field_descriptor + = Data.ProtoLens.FieldDescriptor "description" + (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: + Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "description"))) + :: Data.ProtoLens.FieldDescriptor IndexReply + endpoints__field_descriptor + = Data.ProtoLens.FieldDescriptor "endpoints" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor IndexReply'Endpoint) + (Data.ProtoLens.RepeatedField Data.ProtoLens.Unpacked + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "endpoints"))) + :: Data.ProtoLens.FieldDescriptor IndexReply + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, description__field_descriptor), + (Data.ProtoLens.Tag 2, endpoints__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens _IndexReply'_unknownFields + (\ x__ y__ -> x__{_IndexReply'_unknownFields = y__}) +{- | Fields : + + * 'Proto.Protos.Grpcbin_Fields.path' @:: Lens' IndexReply'Endpoint Data.Text.Text@ + * 'Proto.Protos.Grpcbin_Fields.description' @:: Lens' IndexReply'Endpoint Data.Text.Text@ + -} +data IndexReply'Endpoint = IndexReply'Endpoint{_IndexReply'Endpoint'path + :: !Data.Text.Text, + _IndexReply'Endpoint'description :: !Data.Text.Text, + _IndexReply'Endpoint'_unknownFields :: + !Data.ProtoLens.FieldSet} + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance (Lens.Labels.HasLens' f IndexReply'Endpoint x a, a ~ b) => + Lens.Labels.HasLens f IndexReply'Endpoint IndexReply'Endpoint x a b + where + lensOf = Lens.Labels.lensOf' +instance Prelude.Functor f => + Lens.Labels.HasLens' f IndexReply'Endpoint "path" (Data.Text.Text) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _IndexReply'Endpoint'path + (\ x__ y__ -> x__{_IndexReply'Endpoint'path = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f IndexReply'Endpoint "description" + (Data.Text.Text) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _IndexReply'Endpoint'description + (\ x__ y__ -> x__{_IndexReply'Endpoint'description = y__})) + Prelude.id +instance Data.Default.Class.Default IndexReply'Endpoint where + def + = IndexReply'Endpoint{_IndexReply'Endpoint'path = + Data.ProtoLens.fieldDefault, + _IndexReply'Endpoint'description = Data.ProtoLens.fieldDefault, + _IndexReply'Endpoint'_unknownFields = ([])} +instance Data.ProtoLens.Message IndexReply'Endpoint where + messageName _ = Data.Text.pack "grpcbin.IndexReply.Endpoint" + fieldsByTag + = let path__field_descriptor + = Data.ProtoLens.FieldDescriptor "path" + (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: + Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "path"))) + :: Data.ProtoLens.FieldDescriptor IndexReply'Endpoint + description__field_descriptor + = Data.ProtoLens.FieldDescriptor "description" + (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: + Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "description"))) + :: Data.ProtoLens.FieldDescriptor IndexReply'Endpoint + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, path__field_descriptor), + (Data.ProtoLens.Tag 2, description__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens _IndexReply'Endpoint'_unknownFields + (\ x__ y__ -> x__{_IndexReply'Endpoint'_unknownFields = y__}) +{- | Fields : + + * 'Proto.Protos.Grpcbin_Fields.code' @:: Lens' SpecificErrorRequest Data.Word.Word32@ + * 'Proto.Protos.Grpcbin_Fields.reason' @:: Lens' SpecificErrorRequest Data.Text.Text@ + -} +data SpecificErrorRequest = SpecificErrorRequest{_SpecificErrorRequest'code + :: !Data.Word.Word32, + _SpecificErrorRequest'reason :: !Data.Text.Text, + _SpecificErrorRequest'_unknownFields :: + !Data.ProtoLens.FieldSet} + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) +instance (Lens.Labels.HasLens' f SpecificErrorRequest x a, + a ~ b) => + Lens.Labels.HasLens f SpecificErrorRequest SpecificErrorRequest x a + b + where + lensOf = Lens.Labels.lensOf' +instance Prelude.Functor f => + Lens.Labels.HasLens' f SpecificErrorRequest "code" + (Data.Word.Word32) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _SpecificErrorRequest'code + (\ x__ y__ -> x__{_SpecificErrorRequest'code = y__})) + Prelude.id +instance Prelude.Functor f => + Lens.Labels.HasLens' f SpecificErrorRequest "reason" + (Data.Text.Text) + where + lensOf' _ + = (Prelude..) + (Lens.Family2.Unchecked.lens _SpecificErrorRequest'reason + (\ x__ y__ -> x__{_SpecificErrorRequest'reason = y__})) + Prelude.id +instance Data.Default.Class.Default SpecificErrorRequest where + def + = SpecificErrorRequest{_SpecificErrorRequest'code = + Data.ProtoLens.fieldDefault, + _SpecificErrorRequest'reason = Data.ProtoLens.fieldDefault, + _SpecificErrorRequest'_unknownFields = ([])} +instance Data.ProtoLens.Message SpecificErrorRequest where + messageName _ = Data.Text.pack "grpcbin.SpecificErrorRequest" + fieldsByTag + = let code__field_descriptor + = Data.ProtoLens.FieldDescriptor "code" + (Data.ProtoLens.ScalarField Data.ProtoLens.UInt32Field :: + Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "code"))) + :: Data.ProtoLens.FieldDescriptor SpecificErrorRequest + reason__field_descriptor + = Data.ProtoLens.FieldDescriptor "reason" + (Data.ProtoLens.ScalarField Data.ProtoLens.StringField :: + Data.ProtoLens.FieldTypeDescriptor Data.Text.Text) + (Data.ProtoLens.PlainField Data.ProtoLens.Optional + (Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "reason"))) + :: Data.ProtoLens.FieldDescriptor SpecificErrorRequest + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, code__field_descriptor), + (Data.ProtoLens.Tag 2, reason__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens _SpecificErrorRequest'_unknownFields + (\ x__ y__ -> x__{_SpecificErrorRequest'_unknownFields = y__}) +data GRPCBin = GRPCBin{} + deriving () +instance Data.ProtoLens.Service.Types.Service GRPCBin where + type ServiceName GRPCBin = "GRPCBin" + type ServicePackage GRPCBin = "grpcbin" + type ServiceMethods GRPCBin = + '["dummyBidirectionalStreamStream", "dummyClientStream", + "dummyServerStream", "dummyUnary", "empty", "headersUnary", + "index", "noResponseUnary", "randomError", "specificError"] +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin "index" + where + type MethodName GRPCBin "index" = "Index" + type MethodInput GRPCBin "index" = EmptyMessage + type MethodOutput GRPCBin "index" = IndexReply + type MethodStreamingType GRPCBin "index" = + 'Data.ProtoLens.Service.Types.NonStreaming +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin "empty" + where + type MethodName GRPCBin "empty" = "Empty" + type MethodInput GRPCBin "empty" = EmptyMessage + type MethodOutput GRPCBin "empty" = EmptyMessage + type MethodStreamingType GRPCBin "empty" = + 'Data.ProtoLens.Service.Types.NonStreaming +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin + "dummyUnary" + where + type MethodName GRPCBin "dummyUnary" = "DummyUnary" + type MethodInput GRPCBin "dummyUnary" = DummyMessage + type MethodOutput GRPCBin "dummyUnary" = DummyMessage + type MethodStreamingType GRPCBin "dummyUnary" = + 'Data.ProtoLens.Service.Types.NonStreaming +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin + "dummyServerStream" + where + type MethodName GRPCBin "dummyServerStream" = "DummyServerStream" + type MethodInput GRPCBin "dummyServerStream" = DummyMessage + type MethodOutput GRPCBin "dummyServerStream" = DummyMessage + type MethodStreamingType GRPCBin "dummyServerStream" = + 'Data.ProtoLens.Service.Types.ServerStreaming +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin + "dummyClientStream" + where + type MethodName GRPCBin "dummyClientStream" = "DummyClientStream" + type MethodInput GRPCBin "dummyClientStream" = DummyMessage + type MethodOutput GRPCBin "dummyClientStream" = DummyMessage + type MethodStreamingType GRPCBin "dummyClientStream" = + 'Data.ProtoLens.Service.Types.ClientStreaming +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin + "dummyBidirectionalStreamStream" + where + type MethodName GRPCBin "dummyBidirectionalStreamStream" = + "DummyBidirectionalStreamStream" + type MethodInput GRPCBin "dummyBidirectionalStreamStream" = + DummyMessage + type MethodOutput GRPCBin "dummyBidirectionalStreamStream" = + DummyMessage + type MethodStreamingType GRPCBin "dummyBidirectionalStreamStream" = + 'Data.ProtoLens.Service.Types.BiDiStreaming +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin + "specificError" + where + type MethodName GRPCBin "specificError" = "SpecificError" + type MethodInput GRPCBin "specificError" = SpecificErrorRequest + type MethodOutput GRPCBin "specificError" = EmptyMessage + type MethodStreamingType GRPCBin "specificError" = + 'Data.ProtoLens.Service.Types.NonStreaming +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin + "randomError" + where + type MethodName GRPCBin "randomError" = "RandomError" + type MethodInput GRPCBin "randomError" = EmptyMessage + type MethodOutput GRPCBin "randomError" = EmptyMessage + type MethodStreamingType GRPCBin "randomError" = + 'Data.ProtoLens.Service.Types.NonStreaming +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin + "headersUnary" + where + type MethodName GRPCBin "headersUnary" = "HeadersUnary" + type MethodInput GRPCBin "headersUnary" = EmptyMessage + type MethodOutput GRPCBin "headersUnary" = HeadersMessage + type MethodStreamingType GRPCBin "headersUnary" = + 'Data.ProtoLens.Service.Types.NonStreaming +instance Data.ProtoLens.Service.Types.HasMethodImpl GRPCBin + "noResponseUnary" + where + type MethodName GRPCBin "noResponseUnary" = "NoResponseUnary" + type MethodInput GRPCBin "noResponseUnary" = EmptyMessage + type MethodOutput GRPCBin "noResponseUnary" = EmptyMessage + type MethodStreamingType GRPCBin "noResponseUnary" = + 'Data.ProtoLens.Service.Types.NonStreaming diff --git a/gen/Proto/Protos/Grpcbin_Fields.hs b/gen/Proto/Protos/Grpcbin_Fields.hs new file mode 100644 --- /dev/null +++ b/gen/Proto/Protos/Grpcbin_Fields.hs @@ -0,0 +1,196 @@ +{- This file was auto-generated from protos/grpcbin.proto by the proto-lens-protoc program. -} +{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, + UndecidableInstances, GeneralizedNewtypeDeriving, + MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, + PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds #-} +{-# OPTIONS_GHC -fno-warn-unused-imports#-} +{-# OPTIONS_GHC -fno-warn-duplicate-exports#-} +module Proto.Protos.Grpcbin_Fields where +import qualified Data.ProtoLens.Reexport.Prelude as Prelude +import qualified Data.ProtoLens.Reexport.Data.Int as Data.Int +import qualified Data.ProtoLens.Reexport.Data.Word as Data.Word +import qualified Data.ProtoLens.Reexport.Data.ProtoLens + as Data.ProtoLens +import qualified + Data.ProtoLens.Reexport.Data.ProtoLens.Message.Enum + as Data.ProtoLens.Message.Enum +import qualified + Data.ProtoLens.Reexport.Data.ProtoLens.Service.Types + as Data.ProtoLens.Service.Types +import qualified Data.ProtoLens.Reexport.Lens.Family2 + as Lens.Family2 +import qualified Data.ProtoLens.Reexport.Lens.Family2.Unchecked + as Lens.Family2.Unchecked +import qualified Data.ProtoLens.Reexport.Data.Default.Class + as Data.Default.Class +import qualified Data.ProtoLens.Reexport.Data.Text as Data.Text +import qualified Data.ProtoLens.Reexport.Data.Map as Data.Map +import qualified Data.ProtoLens.Reexport.Data.ByteString + as Data.ByteString +import qualified Data.ProtoLens.Reexport.Data.ByteString.Char8 + as Data.ByteString.Char8 +import qualified Data.ProtoLens.Reexport.Lens.Labels as Lens.Labels +import qualified Data.ProtoLens.Reexport.Text.Read as Text.Read + +code :: + forall f s t a b . (Lens.Labels.HasLens f s t "code" a b) => + Lens.Family2.LensLike f s t a b +code + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "code") +description :: + forall f s t a b . (Lens.Labels.HasLens f s t "description" a b) => + Lens.Family2.LensLike f s t a b +description + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "description") +endpoints :: + forall f s t a b . (Lens.Labels.HasLens f s t "endpoints" a b) => + Lens.Family2.LensLike f s t a b +endpoints + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "endpoints") +fBool :: + forall f s t a b . (Lens.Labels.HasLens f s t "fBool" a b) => + Lens.Family2.LensLike f s t a b +fBool + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fBool") +fBools :: + forall f s t a b . (Lens.Labels.HasLens f s t "fBools" a b) => + Lens.Family2.LensLike f s t a b +fBools + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fBools") +fBytes :: + forall f s t a b . (Lens.Labels.HasLens f s t "fBytes" a b) => + Lens.Family2.LensLike f s t a b +fBytes + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fBytes") +fBytess :: + forall f s t a b . (Lens.Labels.HasLens f s t "fBytess" a b) => + Lens.Family2.LensLike f s t a b +fBytess + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fBytess") +fEnum :: + forall f s t a b . (Lens.Labels.HasLens f s t "fEnum" a b) => + Lens.Family2.LensLike f s t a b +fEnum + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fEnum") +fEnums :: + forall f s t a b . (Lens.Labels.HasLens f s t "fEnums" a b) => + Lens.Family2.LensLike f s t a b +fEnums + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fEnums") +fFloat :: + forall f s t a b . (Lens.Labels.HasLens f s t "fFloat" a b) => + Lens.Family2.LensLike f s t a b +fFloat + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fFloat") +fFloats :: + forall f s t a b . (Lens.Labels.HasLens f s t "fFloats" a b) => + Lens.Family2.LensLike f s t a b +fFloats + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fFloats") +fInt32 :: + forall f s t a b . (Lens.Labels.HasLens f s t "fInt32" a b) => + Lens.Family2.LensLike f s t a b +fInt32 + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fInt32") +fInt32s :: + forall f s t a b . (Lens.Labels.HasLens f s t "fInt32s" a b) => + Lens.Family2.LensLike f s t a b +fInt32s + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fInt32s") +fInt64 :: + forall f s t a b . (Lens.Labels.HasLens f s t "fInt64" a b) => + Lens.Family2.LensLike f s t a b +fInt64 + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fInt64") +fInt64s :: + forall f s t a b . (Lens.Labels.HasLens f s t "fInt64s" a b) => + Lens.Family2.LensLike f s t a b +fInt64s + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fInt64s") +fString :: + forall f s t a b . (Lens.Labels.HasLens f s t "fString" a b) => + Lens.Family2.LensLike f s t a b +fString + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fString") +fStrings :: + forall f s t a b . (Lens.Labels.HasLens f s t "fStrings" a b) => + Lens.Family2.LensLike f s t a b +fStrings + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fStrings") +fSub :: + forall f s t a b . (Lens.Labels.HasLens f s t "fSub" a b) => + Lens.Family2.LensLike f s t a b +fSub + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fSub") +fSubs :: + forall f s t a b . (Lens.Labels.HasLens f s t "fSubs" a b) => + Lens.Family2.LensLike f s t a b +fSubs + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "fSubs") +key :: + forall f s t a b . (Lens.Labels.HasLens f s t "key" a b) => + Lens.Family2.LensLike f s t a b +key + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "key") +maybe'fSub :: + forall f s t a b . (Lens.Labels.HasLens f s t "maybe'fSub" a b) => + Lens.Family2.LensLike f s t a b +maybe'fSub + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'fSub") +maybe'value :: + forall f s t a b . (Lens.Labels.HasLens f s t "maybe'value" a b) => + Lens.Family2.LensLike f s t a b +maybe'value + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "maybe'value") +metadata :: + forall f s t a b . (Lens.Labels.HasLens f s t "metadata" a b) => + Lens.Family2.LensLike f s t a b +metadata + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "metadata") +path :: + forall f s t a b . (Lens.Labels.HasLens f s t "path" a b) => + Lens.Family2.LensLike f s t a b +path + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "path") +reason :: + forall f s t a b . (Lens.Labels.HasLens f s t "reason" a b) => + Lens.Family2.LensLike f s t a b +reason + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "reason") +value :: + forall f s t a b . (Lens.Labels.HasLens f s t "value" a b) => + Lens.Family2.LensLike f s t a b +value + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "value") +values :: + forall f s t a b . (Lens.Labels.HasLens f s t "values" a b) => + Lens.Family2.LensLike f s t a b +values + = Lens.Labels.lensOf + ((Lens.Labels.proxy#) :: (Lens.Labels.Proxy#) "values") diff --git a/src/Network/GRPC/Server.hs b/src/Network/GRPC/Server.hs new file mode 100644 --- /dev/null +++ b/src/Network/GRPC/Server.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- TODO: +-- * read timeout +-- * proper primitives for streaming +module Network.GRPC.Server + ( runGrpc + , UnaryHandler + , ServerStreamHandler + , ServerStream(..) + , ClientStreamHandler + , ClientStream(..) + -- * registration + , ServiceHandler + , unary + , serverStream + , clientStream + -- * registration + , GRPCStatus (..) + , throwIO + , GRPCStatusMessage + , GRPCStatusCode (..) + -- * to work directly with WAI + , grpcApp + , grpcService + ) where + +import Control.Exception (throwIO) +import Network.GRPC.HTTP2.Encoding (Compression) +import Network.GRPC.HTTP2.Types (GRPCStatus(..), GRPCStatusCode(..), GRPCStatusMessage) +import Network.Wai.Handler.WarpTLS (TLSSettings, runTLS) +import Network.Wai.Handler.Warp (Settings) + +import Network.GRPC.Server.Handlers (UnaryHandler, unary, ServerStreamHandler, ServerStream(..), serverStream, ClientStreamHandler, ClientStream(..), clientStream) +import Network.GRPC.Server.Wai (ServiceHandler(..), grpcApp, grpcService) + +-- | Helper to constructs and serve a gRPC over HTTP2 application. +-- +-- You may want to use 'grpcApp' for adding middlewares to your gRPC server. +runGrpc + :: TLSSettings + -- ^ TLS settings for the HTTP2 server. + -> Settings + -- ^ Warp settings. + -> [ServiceHandler] + -- ^ List of ServiceHandler. Refer to 'grcpApp' + -> [Compression] + -- ^ Compression methods used. + -> IO () +runGrpc tlsSettings settings handlers compressions = + runTLS tlsSettings settings (grpcApp compressions handlers) diff --git a/src/Network/GRPC/Server/Handlers.hs b/src/Network/GRPC/Server/Handlers.hs new file mode 100644 --- /dev/null +++ b/src/Network/GRPC/Server/Handlers.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +module Network.GRPC.Server.Handlers where + +import Data.Binary.Get (pushChunk, Decoder(..)) +import qualified Data.ByteString.Char8 as ByteString +import Data.ByteString.Char8 (ByteString) +import Data.ByteString.Lazy (toStrict) +import Data.ProtoLens.Message (Message) +import Data.ProtoLens.Service.Types (Service(..), HasMethod, HasMethodImpl(..)) +import Network.GRPC.HTTP2.Encoding (decodeInput, encodeOutput, Encoding(..), Decoding(..)) +import Network.GRPC.HTTP2.Types (RPC(..), GRPCStatus(..), GRPCStatusCode(..), path) +import Network.Wai (Request, requestBody, strictRequestBody) + +import Network.GRPC.Server.Wai (WaiHandler, ServiceHandler(..), closeEarly) + +-- | Handy type to refer to Handler for 'unary' RPCs handler. +type UnaryHandler s m = Request -> MethodInput s m -> IO (MethodOutput s m) + +-- | Handy type for 'server-streaming' RPCs. +-- +-- We expect an implementation to: +-- - read the input request +-- - return an initial state and an state-passing action that the server code will call to fetch the output to send to the client (or close an a Nothing) +-- See 'ServerStream' for the type which embodies these requirements. +type ServerStreamHandler s m a = Request -> MethodInput s m -> IO (a, ServerStream s m a) + +newtype ServerStream s m a = ServerStream { + serverStreamNext :: a -> IO (Maybe (a, MethodOutput s m)) + } + +-- | Handy type for 'client-streaming' RPCs. +-- +-- We expect an implementation to: +-- - acknowledge a the new client stream by returning an initial state and two functions: +-- - a state-passing handler for new client message +-- - a state-aware handler for answering the client when it is ending its stream +-- See 'ClientStream' for the type which embodies these requirements. +type ClientStreamHandler s m a = Request -> IO (a, ClientStream s m a) + +data ClientStream s m a = ClientStream { + clientStreamHandler :: a -> MethodInput s m -> IO a + , clientStreamFinalizer :: a -> IO (MethodOutput s m) + } + +-- | Construct a handler for handling a unary RPC. +unary + :: (Service s, HasMethod s m) + => RPC s m + -> UnaryHandler s m + -> ServiceHandler +unary rpc handler = + ServiceHandler (path rpc) (handleUnary rpc handler) + +-- | Construct a handler for handling a server-streaming RPC. +serverStream + :: (Service s, HasMethod s m) + => RPC s m + -> ServerStreamHandler s m a + -> ServiceHandler +serverStream rpc handler = + ServiceHandler (path rpc) (handleServerStream rpc handler) + +-- | Construct a handler for handling a client-streaming RPC. +clientStream + :: (Service s, HasMethod s m) + => RPC s m + -> ClientStreamHandler s m a + -> ServiceHandler +clientStream rpc handler = + ServiceHandler (path rpc) (handleClientStream rpc handler) + +-- | Handle unary RPCs. +handleUnary :: + (Service s, HasMethod s m) + => RPC s m + -> UnaryHandler s m + -> WaiHandler +handleUnary rpc handler decoding encoding req write flush = do + handleRequestChunksLoop (decodeInput rpc $ _getDecodingCompression decoding) handleMsg handleEof nextChunk + where + nextChunk = toStrict <$> strictRequestBody req + handleMsg = errorOnLeftOver (\i -> handler req i >>= reply) + handleEof = closeEarly (GRPCStatus INVALID_ARGUMENT "early end of request body") + reply msg = write (encodeOutput rpc (_getEncodingCompression encoding) msg) >> flush + +-- | Handle Server-Streaming RPCs. +handleServerStream :: + (Service s, HasMethod s m) + => RPC s m + -> ServerStreamHandler s m a + -> WaiHandler +handleServerStream rpc handler decoding encoding req write flush = do + handleRequestChunksLoop (decodeInput rpc $ _getDecodingCompression decoding) handleMsg handleEof nextChunk + where + nextChunk = toStrict <$> strictRequestBody req + handleMsg = errorOnLeftOver (\i -> handler req i >>= replyN) + handleEof = closeEarly (GRPCStatus INVALID_ARGUMENT "early end of request body") + replyN (v, sStream) = do + let go v1 = serverStreamNext sStream v1 >>= \case + Just (v2, msg) -> do + write (encodeOutput rpc (_getEncodingCompression encoding) msg) >> flush + go v2 + Nothing -> pure () + go v + +-- | Handle Client-Streaming RPCs. +handleClientStream :: + (Service s, HasMethod s m) + => RPC s m + -> ClientStreamHandler s m a + -> WaiHandler +handleClientStream rpc handler0 decoding encoding req write flush = do + handler0 req >>= go + where + go (v, cStream) = handleRequestChunksLoop (decodeInput rpc $ _getDecodingCompression decoding) (handleMsg v) (handleEof v) nextChunk + where + nextChunk = requestBody req + handleMsg v0 dat msg = clientStreamHandler cStream v0 msg >>= \v1 -> loop dat v1 + handleEof v0 = clientStreamFinalizer cStream v0 >>= reply + reply msg = write (encodeOutput rpc (_getEncodingCompression encoding) msg) >> flush + loop chunk v1 = handleRequestChunksLoop (flip pushChunk chunk $ decodeInput rpc (_getDecodingCompression decoding)) (handleMsg v1) (handleEof v1) nextChunk + +-- | Helpers to consume input in chunks. +handleRequestChunksLoop + :: (Message a) + => Decoder (Either String a) + -- ^ Message decoder. + -> (ByteString -> a -> IO ()) + -- ^ Handler for a single message. + -- The ByteString corresponds to leftover data. + -> IO () + -- ^ Handler for handling end-of-streams. + -> IO ByteString + -- ^ Action to retrieve the next chunk. + -> IO () +{-# INLINEABLE handleRequestChunksLoop #-} +handleRequestChunksLoop decoder handleMsg handleEof nextChunk = + case decoder of + (Done unusedDat _ (Right val)) -> do + handleMsg unusedDat val + (Done _ _ (Left err)) -> do + closeEarly (GRPCStatus INVALID_ARGUMENT (ByteString.pack $ "done-error: " ++ err)) + (Fail _ _ err) -> + closeEarly (GRPCStatus INVALID_ARGUMENT (ByteString.pack $ "fail-error: " ++ err)) + partial@(Partial _) -> do + chunk <- nextChunk + if ByteString.null chunk + then + handleEof + else + handleRequestChunksLoop (pushChunk partial chunk) handleMsg handleEof nextChunk + +-- | Combinator around message handler to error on left overs. +-- +-- This combinator ensures that, unless for client stream, an unparsed piece of +-- data with a correctly-read message is treated as an error. +errorOnLeftOver :: (a -> IO b) -> ByteString -> a -> IO b +errorOnLeftOver f rest + | ByteString.null rest = f + | otherwise = const $ closeEarly $ GRPCStatus INVALID_ARGUMENT ("left-overs: " <> rest) diff --git a/src/Network/GRPC/Server/Helpers.hs b/src/Network/GRPC/Server/Helpers.hs new file mode 100644 --- /dev/null +++ b/src/Network/GRPC/Server/Helpers.hs @@ -0,0 +1,21 @@ + + +module Network.GRPC.Server.Helpers where + +import qualified Data.ByteString.Char8 as ByteString +import Data.Maybe (fromMaybe) +import Network.GRPC.HTTP2.Types (GRPCStatus(..), trailerForStatusCode, grpcStatusH, grpcMessageH) +import Network.Wai (Request) +import Network.Wai.Handler.Warp (http2dataTrailers, defaultHTTP2Data, modifyHTTP2Data, HTTP2Data) + +-- | Helper to set the GRPCStatus on the trailers reply. +modifyGRPCStatus :: Request -> GRPCStatus -> IO () +modifyGRPCStatus req = modifyHTTP2Data req . makeGRPCTrailers + +makeGRPCTrailers :: GRPCStatus -> (Maybe HTTP2Data -> Maybe HTTP2Data) +makeGRPCTrailers (GRPCStatus s msg) h2data = + Just $! (fromMaybe defaultHTTP2Data h2data) { http2dataTrailers = trailers } + where + trailers = if ByteString.null msg then [status] else [status, message] + status = (grpcStatusH, trailerForStatusCode s) + message = (grpcMessageH, msg) diff --git a/src/Network/GRPC/Server/Wai.hs b/src/Network/GRPC/Server/Wai.hs new file mode 100644 --- /dev/null +++ b/src/Network/GRPC/Server/Wai.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Network.GRPC.Server.Wai where + +import Control.Exception (Handler(..), catches, SomeException, throwIO) +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as ByteString +import Data.ByteString.Lazy (fromStrict) +import Data.Binary.Builder (Builder) +import Data.Maybe (fromMaybe) +import qualified Data.CaseInsensitive as CI +import qualified Data.List as List +import Network.GRPC.HTTP2.Encoding (Compression, Encoding(..), Decoding(..), grpcCompressionHV, uncompressed) +import Network.GRPC.HTTP2.Types (GRPCStatus(..), GRPCStatusCode(..), grpcStatusH, grpcMessageH, grpcContentTypeHV, grpcEncodingH, grpcAcceptEncodingH) +import Network.HTTP.Types (status200, status404) +import Network.Wai (Application, Request(..), rawPathInfo, responseLBS, responseStream, requestHeaders) + +import Network.GRPC.Server.Helpers (modifyGRPCStatus) + +-- | A Wai Handler for a request. +type WaiHandler = + Decoding + -- ^ Compression for the request inputs. + -> Encoding + -- ^ Compression for the request outputs. + -> Request + -- ^ Request object. + -> (Builder -> IO ()) + -- ^ Write a data chunk in the reply. + -> IO () + -- ^ Flush the output. + -> IO () + +-- | Untyped gRPC Service handler. +data ServiceHandler = ServiceHandler { + grpcHandlerPath :: ByteString + -- ^ Path to the Service to be handled. + , grpcWaiHandler :: WaiHandler + -- ^ Actual request handler. + } + +-- | Build a WAI 'Application' from a list of ServiceHandler. +-- +-- Currently, gRPC calls are lookuped up by traversing the list of ServiceHandler. +-- This lookup may be inefficient for large amount of servics. +grpcApp :: [Compression] -> [ServiceHandler] -> Application +grpcApp compressions services = + grpcService compressions services err404app + where + err404app :: Application + err404app req rep = + rep $ responseLBS status404 [] $ fromStrict ("not found: " <> rawPathInfo req) + +-- | Aborts a GRPC handler with a given GRPCStatus. +closeEarly :: GRPCStatus -> IO a +closeEarly = throwIO + +-- | Build a WAI 'Middleware' from a list of ServiceHandler. +-- +-- Currently, gRPC calls are lookuped up by traversing the list of ServiceHandler. +-- This lookup may be inefficient for large amount of services. +grpcService :: [Compression] -> [ServiceHandler] -> (Application -> Application) +grpcService compressions services app = \req rep -> do + case lookupHandler (rawPathInfo req) services of + Just handler -> + -- Handler that catches early GRPC termination and other exceptions. + -- + -- Other exceptions are turned into GRPC status INTERNAL (rather + -- than returning a 500). + -- + -- These exceptions are swallowed from the WAI "onException" + -- handler, so we'll need a better way to handle this case. + let grpcHandler write flush = + (doHandle handler req write flush) + `catches` [ Handler $ \(e::GRPCStatus) -> modifyGRPCStatus req e + , Handler $ \(e::SomeException) -> modifyGRPCStatus req (GRPCStatus INTERNAL $ ByteString.pack $ show e ) + ] + in (rep $ responseStream status200 hdrs200 grpcHandler) + Nothing -> + app req rep + where + hdrs200 = [ + ("content-type", grpcContentTypeHV) + , ("trailer", CI.original grpcStatusH) + , ("trailer", CI.original grpcMessageH) + ] + lookupHandler :: ByteString -> [ServiceHandler] -> Maybe WaiHandler + lookupHandler p plainHandlers = grpcWaiHandler <$> + List.find (\(ServiceHandler rpcPath _) -> rpcPath == p) plainHandlers + doHandle handler req write flush = do + let bestCompression = lookupEncoding req compressions + let pickedCompression = fromMaybe (Encoding uncompressed) bestCompression + + let hopefulDecompression = lookupDecoding req compressions + let pickedDecompression = fromMaybe (Decoding uncompressed) hopefulDecompression + + _ <- handler pickedDecompression pickedCompression req write flush + modifyGRPCStatus req (GRPCStatus OK "WAI handler ended.") + +-- | Looks-up header for encoding outgoing messages. +requestAcceptEncodingNames :: Request -> [ByteString] +requestAcceptEncodingNames req = fromMaybe [] $ + ByteString.split ',' <$> lookup grpcAcceptEncodingH (requestHeaders req) + +-- | Looks-up the compression to use from a set of known algorithms. +lookupEncoding :: Request -> [Compression] -> Maybe Encoding +lookupEncoding req compressions = fmap Encoding $ + safeHead [ c | c <- compressions + , n <- requestAcceptEncodingNames req + , n == grpcCompressionHV c + ] + where + safeHead [] = Nothing + safeHead (x:_) = Just x + +-- | Looks-up header for decoding incoming messages. +requestDecodingName :: Request -> Maybe ByteString +requestDecodingName req = lookup grpcEncodingH (requestHeaders req) + +-- | Looks-up the compression to use for decoding messages. +lookupDecoding :: Request -> [Compression] -> Maybe Decoding +lookupDecoding req compressions = fmap Decoding $ do + d <- requestDecodingName req + lookup d [(grpcCompressionHV c, c) | c <- compressions] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/warp-grpc.cabal b/warp-grpc.cabal new file mode 100644 --- /dev/null +++ b/warp-grpc.cabal @@ -0,0 +1,96 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: d116fcb32e265f228bd3deb1c4665cd8477e5dd7fa46ea0b2af4d678c06c0fc6 + +name: warp-grpc +version: 0.1.0.0 +synopsis: A minimal gRPC server on top of Warp. +description: Please see the README on Github at +category: Networking +homepage: https://github.com/lucasdicioccio/warp-grpc#readme +bug-reports: https://github.com/lucasdicioccio/warp-grpc/issues +author: Lucas DiCioccio +maintainer: lucas@dicioccio.fr +copyright: 2017 Lucas DiCioccio +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/lucasdicioccio/warp-grpc + +library + exposed-modules: + Network.GRPC.Server + Network.GRPC.Server.Handlers + Network.GRPC.Server.Helpers + Network.GRPC.Server.Wai + other-modules: + Paths_warp_grpc + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , binary + , bytestring + , case-insensitive + , http-types + , http2-grpc-types >=0.2 + , proto-lens + , wai + , warp >=3.2.24 && <3.3 + , warp-tls + default-language: Haskell2010 + +executable warp-grpc-exe + main-is: Main.hs + other-modules: + Proto.Protos.Grpcbin + Proto.Protos.Grpcbin_Fields + hs-source-dirs: + app + gen + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , binary + , bytestring + , case-insensitive + , http-types + , http2-grpc-types >=0.2 + , proto-lens + , proto-lens-protoc + , wai + , warp >=3.2.24 && <3.3 + , warp-grpc + , warp-tls + default-language: Haskell2010 + +test-suite warp-grpc-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_warp_grpc + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , binary + , bytestring + , case-insensitive + , http-types + , http2-grpc-types >=0.2 + , proto-lens + , wai + , warp >=3.2.24 && <3.3 + , warp-grpc + , warp-tls + default-language: Haskell2010