From 2af32db3a96c349f6a28abcb63ea009a79b03b0c Mon Sep 17 00:00:00 2001 From: Gabriel Gonzalez Date: Mon, 11 Jan 2021 09:24:25 -0800 Subject: [PATCH] Fix examples (#115) Fixes https://github.com/awakesecurity/gRPC-haskell/issues/112 --- examples/echo/echo-hs/Echo.hs | 82 ++++++++++++++++----------- examples/hellos/hellos-server/Main.hs | 1 - examples/tutorial/Arithmetic.hs | 6 +- grpc-haskell.cabal | 2 + release.nix | 6 +- 5 files changed, 56 insertions(+), 41 deletions(-) diff --git a/examples/echo/echo-hs/Echo.hs b/examples/echo/echo-hs/Echo.hs index 9ba8f3b..aa60450 100644 --- a/examples/echo/echo-hs/Echo.hs +++ b/examples/echo/echo-hs/Echo.hs @@ -1,49 +1,58 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT! + module Echo where import qualified Prelude as Hs -import qualified Proto3.Suite.DotProto as HsProtobuf -import qualified Proto3.Suite.Types as HsProtobuf import qualified Proto3.Suite.Class as HsProtobuf +import qualified Proto3.Suite.DotProto as HsProtobuf import qualified Proto3.Suite.JSONPB as HsJSONPB import Proto3.Suite.JSONPB ((.=), (.:)) +import qualified Proto3.Suite.Types as HsProtobuf import qualified Proto3.Wire as HsProtobuf -import Control.Applicative ((<*>), (<|>), (<$>)) import qualified Control.Applicative as Hs +import Control.Applicative ((<*>), (<|>), (<$>)) +import qualified Control.DeepSeq as Hs import qualified Control.Monad as Hs -import qualified Data.Text.Lazy as Hs (Text) import qualified Data.ByteString as Hs -import qualified Data.String as Hs (fromString) -import qualified Data.Vector as Hs (Vector) +import qualified Data.Coerce as Hs import qualified Data.Int as Hs (Int16, Int32, Int64) -import qualified Data.Word as Hs (Word16, Word32, Word64) +import qualified Data.List.NonEmpty as Hs (NonEmpty(..)) +import qualified Data.Map as Hs (Map, mapKeysMonotonic) import qualified Data.Proxy as Proxy -import qualified GHC.Generics as Hs +import qualified Data.String as Hs (fromString) +import qualified Data.Text.Lazy as Hs (Text) +import qualified Data.Vector as Hs (Vector) +import qualified Data.Word as Hs (Word16, Word32, Word64) import qualified GHC.Enum as Hs +import qualified GHC.Generics as Hs +import qualified Unsafe.Coerce as Hs import Network.GRPC.HighLevel.Generated as HsGRPC import Network.GRPC.HighLevel.Client as HsGRPC import Network.GRPC.HighLevel.Server as HsGRPC hiding (serverLoop) import Network.GRPC.HighLevel.Server.Unregistered as HsGRPC (serverLoop) - + data Echo request response = Echo{echoDoEcho :: request 'HsGRPC.Normal Echo.EchoRequest Echo.EchoResponse -> Hs.IO (response 'HsGRPC.Normal Echo.EchoResponse)} deriving Hs.Generic - + echoServer :: Echo HsGRPC.ServerRequest HsGRPC.ServerResponse -> HsGRPC.ServiceOptions -> Hs.IO () echoServer Echo{echoDoEcho = echoDoEcho} (ServiceOptions serverHost serverPort useCompression - userAgentPrefix userAgentSuffix initialMetadata sslConfig logger) + userAgentPrefix userAgentSuffix initialMetadata sslConfig logger + serverMaxReceiveMessageLength) = (HsGRPC.serverLoop HsGRPC.defaultOptions{HsGRPC.optNormalHandlers = [(HsGRPC.UnaryHandler (HsGRPC.MethodName "/echo.Echo/DoEcho") @@ -55,8 +64,9 @@ echoServer Echo{echoDoEcho = echoDoEcho} optUserAgentPrefix = userAgentPrefix, optUserAgentSuffix = userAgentSuffix, optInitialMetadata = initialMetadata, optSSLConfig = sslConfig, - optLogger = logger}) - + optLogger = logger, + optMaxReceiveMessageLength = serverMaxReceiveMessageLength}) + echoClient :: HsGRPC.Client -> Hs.IO (Echo HsGRPC.ClientRequest HsGRPC.ClientResult) @@ -65,13 +75,15 @@ echoClient client ((Hs.pure (HsGRPC.clientRequest client)) <*> (HsGRPC.clientRegisterMethod client (HsGRPC.MethodName "/echo.Echo/DoEcho"))) - -data EchoRequest = EchoRequest{echoRequestMessage :: Hs.Text} - deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic) - + +newtype EchoRequest = EchoRequest{echoRequestMessage :: Hs.Text} + deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) + instance HsProtobuf.Named EchoRequest where nameOf _ = (Hs.fromString "EchoRequest") - + +instance HsProtobuf.HasDefault EchoRequest + instance HsProtobuf.Message EchoRequest where encodeMessage _ EchoRequest{echoRequestMessage = echoRequestMessage} @@ -88,23 +100,23 @@ instance HsProtobuf.Message EchoRequest where (HsProtobuf.Single "message") [] "")] - + instance HsJSONPB.ToJSONPB EchoRequest where toJSONPB (EchoRequest f1) = (HsJSONPB.object ["message" .= f1]) toEncodingPB (EchoRequest f1) = (HsJSONPB.pairs ["message" .= f1]) - + instance HsJSONPB.FromJSONPB EchoRequest where parseJSONPB = (HsJSONPB.withObject "EchoRequest" (\ obj -> (Hs.pure EchoRequest) <*> obj .: "message")) - + instance HsJSONPB.ToJSON EchoRequest where toJSON = HsJSONPB.toAesonValue toEncoding = HsJSONPB.toAesonEncoding - + instance HsJSONPB.FromJSON EchoRequest where parseJSON = HsJSONPB.parseJSONPB - + instance HsJSONPB.ToSchema EchoRequest where declareNamedSchema _ = do let declare_message = HsJSONPB.declareSchemaRef @@ -120,13 +132,15 @@ instance HsJSONPB.ToSchema EchoRequest where HsJSONPB._schemaProperties = HsJSONPB.insOrdFromList [("message", echoRequestMessage)]}}) - -data EchoResponse = EchoResponse{echoResponseMessage :: Hs.Text} - deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic) - + +newtype EchoResponse = EchoResponse{echoResponseMessage :: Hs.Text} + deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData) + instance HsProtobuf.Named EchoResponse where nameOf _ = (Hs.fromString "EchoResponse") - + +instance HsProtobuf.HasDefault EchoResponse + instance HsProtobuf.Message EchoResponse where encodeMessage _ EchoResponse{echoResponseMessage = echoResponseMessage} @@ -143,23 +157,23 @@ instance HsProtobuf.Message EchoResponse where (HsProtobuf.Single "message") [] "")] - + instance HsJSONPB.ToJSONPB EchoResponse where toJSONPB (EchoResponse f1) = (HsJSONPB.object ["message" .= f1]) toEncodingPB (EchoResponse f1) = (HsJSONPB.pairs ["message" .= f1]) - + instance HsJSONPB.FromJSONPB EchoResponse where parseJSONPB = (HsJSONPB.withObject "EchoResponse" (\ obj -> (Hs.pure EchoResponse) <*> obj .: "message")) - + instance HsJSONPB.ToJSON EchoResponse where toJSON = HsJSONPB.toAesonValue toEncoding = HsJSONPB.toAesonEncoding - + instance HsJSONPB.FromJSON EchoResponse where parseJSON = HsJSONPB.parseJSONPB - + instance HsJSONPB.ToSchema EchoResponse where declareNamedSchema _ = do let declare_message = HsJSONPB.declareSchemaRef @@ -174,4 +188,4 @@ instance HsJSONPB.ToSchema EchoResponse where Hs.Just HsJSONPB.SwaggerObject}, HsJSONPB._schemaProperties = HsJSONPB.insOrdFromList - [("message", echoResponseMessage)]}}) + [("message", echoResponseMessage)]}}) \ No newline at end of file diff --git a/examples/hellos/hellos-server/Main.hs b/examples/hellos/hellos-server/Main.hs index 1802b53..7fdc02a 100644 --- a/examples/hellos/hellos-server/Main.hs +++ b/examples/hellos/hellos-server/Main.hs @@ -10,7 +10,6 @@ import Control.Monad import Data.Function (fix) -import Data.Monoid import qualified Data.Text as T import Data.Word import GHC.Generics (Generic) diff --git a/examples/tutorial/Arithmetic.hs b/examples/tutorial/Arithmetic.hs index cc35925..520957a 100644 --- a/examples/tutorial/Arithmetic.hs +++ b/examples/tutorial/Arithmetic.hs @@ -62,7 +62,8 @@ arithmeticServer Arithmetic{arithmeticAdd = arithmeticAdd, arithmeticRunningSum = arithmeticRunningSum} (ServiceOptions serverHost serverPort useCompression - userAgentPrefix userAgentSuffix initialMetadata sslConfig logger) + userAgentPrefix userAgentSuffix initialMetadata sslConfig logger + serverMaxReceiveMessageLength) = (HsGRPC.serverLoop HsGRPC.defaultOptions{HsGRPC.optNormalHandlers = [(HsGRPC.UnaryHandler @@ -79,7 +80,8 @@ arithmeticServer optUserAgentPrefix = userAgentPrefix, optUserAgentSuffix = userAgentSuffix, optInitialMetadata = initialMetadata, optSSLConfig = sslConfig, - optLogger = logger}) + optLogger = logger, + optMaxReceiveMessageLength = serverMaxReceiveMessageLength}) arithmeticClient :: HsGRPC.Client -> diff --git a/grpc-haskell.cabal b/grpc-haskell.cabal index 38a4291..b1480a7 100644 --- a/grpc-haskell.cabal +++ b/grpc-haskell.cabal @@ -97,6 +97,7 @@ executable echo-server , async , bytestring == 0.10.* , containers >=0.5 && <0.7 + , deepseq , grpc-haskell , grpc-haskell-core , optparse-generic @@ -169,6 +170,7 @@ executable echo-client , async , bytestring == 0.10.* , containers >=0.5 && <0.7 + , deepseq , grpc-haskell , grpc-haskell-core , optparse-generic diff --git a/release.nix b/release.nix index 89f317d..b65248e 100644 --- a/release.nix +++ b/release.nix @@ -1,9 +1,7 @@ # If you would like to test and build changes quickly using `cabal`, run: # -# $ # Consider adding the following command to your `~/.profile` -# $ NIX_PATH="${NIX_PATH}:ssh-config-file=${HOME}/.ssh/config:ssh-auth-sock=${SSH_AUTH_SOCK}" -# $ nix-shell -A grpc-haskell.env release.nix -# [nix-shell]$ cabal configure --enable-tests && cabal build && cabal test +# $ nix-shell +# [nix-shell]$ cabal configure --enable-tests && cabal test # # This will open up a Nix shell where all of your Haskell tools will work like # normal, except that all dependencies (including C libraries) are managed by