grpc-haskell 0.0.1.0 → 0.1.0
raw patch · 8 files changed
+109/−70 lines, 8 filesdep +deepseqdep ~proto3-suitedep ~proto3-wire
Dependencies added: deepseq
Dependency ranges changed: proto3-suite, proto3-wire
Files
- examples/echo/echo-hs/Echo.hs +46/−32
- examples/hellos/hellos-client/Main.hs +1/−1
- examples/hellos/hellos-server/Main.hs +1/−2
- examples/tutorial/Arithmetic.hs +45/−31
- grpc-haskell.cabal +7/−4
- src/Network/GRPC/HighLevel/Generated.hs +4/−0
- src/Network/GRPC/HighLevel/Server.hs +3/−0
- src/Network/GRPC/HighLevel/Server/Unregistered.hs +2/−0
examples/echo/echo-hs/Echo.hs view
@@ -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.Coerce as Hs+import qualified Data.Int as Hs (Int16, Int32, Int64)+import qualified Data.List.NonEmpty as Hs (NonEmpty(..))+import qualified Data.Map as Hs (Map, mapKeysMonotonic)+import qualified Data.Proxy as Proxy 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.Int as Hs (Int16, Int32, Int64) import qualified Data.Word as Hs (Word16, Word32, Word64)-import qualified Data.Proxy as Proxy-import qualified GHC.Generics as Hs 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 @@ 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 @@ ((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 @@ (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 @@ 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 @@ (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
examples/hellos/hellos-client/Main.hs view
@@ -31,7 +31,7 @@ data BiRqtRpy = BiRqtRpy { biMessage :: T.Text } deriving (Show, Eq, Ord, Generic) instance Message BiRqtRpy -expect :: (Eq a, Monad m, Show a) => String -> a -> a -> m ()+expect :: (Eq a, MonadFail m, Show a) => String -> a -> a -> m () expect ctx ex got | ex /= got = fail $ ctx ++ " error: expected " ++ show ex ++ ", got " ++ show got | otherwise = return ()
examples/hellos/hellos-server/Main.hs view
@@ -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)@@ -33,7 +32,7 @@ data BiRqtRpy = BiRqtRpy { biMessage :: T.Text } deriving (Show, Eq, Ord, Generic) instance Message BiRqtRpy -expect :: (Eq a, Monad m, Show a) => String -> a -> a -> m ()+expect :: (Eq a, MonadFail m, Show a) => String -> a -> a -> m () expect ctx ex got | ex /= got = fail $ ctx ++ " error: expected " ++ show ex ++ ", got " ++ show got | otherwise = return ()
examples/tutorial/Arithmetic.hs view
@@ -1,38 +1,46 @@ {-# 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 Arithmetic 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.Coerce as Hs+import qualified Data.Int as Hs (Int16, Int32, Int64)+import qualified Data.List.NonEmpty as Hs (NonEmpty(..))+import qualified Data.Map as Hs (Map, mapKeysMonotonic)+import qualified Data.Proxy as Proxy 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.Int as Hs (Int16, Int32, Int64) import qualified Data.Word as Hs (Word16, Word32, Word64)-import qualified Data.Proxy as Proxy-import qualified GHC.Generics as Hs 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 Arithmetic request response = Arithmetic{arithmeticAdd :: request 'HsGRPC.Normal Arithmetic.TwoInts Arithmetic.OneInt@@ -46,7 +54,7 @@ (response 'HsGRPC.ClientStreaming Arithmetic.OneInt)} deriving Hs.Generic-+ arithmeticServer :: Arithmetic HsGRPC.ServerRequest HsGRPC.ServerResponse -> HsGRPC.ServiceOptions -> Hs.IO ()@@ -54,7 +62,8 @@ 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@@ -71,8 +80,9 @@ optUserAgentPrefix = userAgentPrefix, optUserAgentSuffix = userAgentSuffix, optInitialMetadata = initialMetadata, optSSLConfig = sslConfig,- optLogger = logger})-+ optLogger = logger,+ optMaxReceiveMessageLength = serverMaxReceiveMessageLength})+ arithmeticClient :: HsGRPC.Client -> Hs.IO (Arithmetic HsGRPC.ClientRequest HsGRPC.ClientResult)@@ -85,13 +95,15 @@ ((Hs.pure (HsGRPC.clientRequest client)) <*> (HsGRPC.clientRegisterMethod client (HsGRPC.MethodName "/arithmetic.Arithmetic/RunningSum")))-+ data TwoInts = TwoInts{twoIntsX :: Hs.Int32, twoIntsY :: Hs.Int32}- deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)-+ deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData)+ instance HsProtobuf.Named TwoInts where nameOf _ = (Hs.fromString "TwoInts")-+ +instance HsProtobuf.HasDefault TwoInts+ instance HsProtobuf.Message TwoInts where encodeMessage _ TwoInts{twoIntsX = twoIntsX, twoIntsY = twoIntsY} = (Hs.mconcat@@ -117,24 +129,24 @@ (HsProtobuf.Single "y") [] "")]-+ instance HsJSONPB.ToJSONPB TwoInts where toJSONPB (TwoInts f1 f2) = (HsJSONPB.object ["x" .= f1, "y" .= f2]) toEncodingPB (TwoInts f1 f2) = (HsJSONPB.pairs ["x" .= f1, "y" .= f2])-+ instance HsJSONPB.FromJSONPB TwoInts where parseJSONPB = (HsJSONPB.withObject "TwoInts" (\ obj -> (Hs.pure TwoInts) <*> obj .: "x" <*> obj .: "y"))-+ instance HsJSONPB.ToJSON TwoInts where toJSON = HsJSONPB.toAesonValue toEncoding = HsJSONPB.toAesonEncoding-+ instance HsJSONPB.FromJSON TwoInts where parseJSON = HsJSONPB.parseJSONPB-+ instance HsJSONPB.ToSchema TwoInts where declareNamedSchema _ = do let declare_x = HsJSONPB.declareSchemaRef@@ -153,13 +165,15 @@ HsJSONPB._schemaProperties = HsJSONPB.insOrdFromList [("x", twoIntsX), ("y", twoIntsY)]}})--data OneInt = OneInt{oneIntResult :: Hs.Int32}- deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)-+ +newtype OneInt = OneInt{oneIntResult :: Hs.Int32}+ deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData)+ instance HsProtobuf.Named OneInt where nameOf _ = (Hs.fromString "OneInt")-+ +instance HsProtobuf.HasDefault OneInt+ instance HsProtobuf.Message OneInt where encodeMessage _ OneInt{oneIntResult = oneIntResult} = (Hs.mconcat@@ -175,23 +189,23 @@ (HsProtobuf.Single "result") [] "")]-+ instance HsJSONPB.ToJSONPB OneInt where toJSONPB (OneInt f1) = (HsJSONPB.object ["result" .= f1]) toEncodingPB (OneInt f1) = (HsJSONPB.pairs ["result" .= f1])-+ instance HsJSONPB.FromJSONPB OneInt where parseJSONPB = (HsJSONPB.withObject "OneInt" (\ obj -> (Hs.pure OneInt) <*> obj .: "result"))-+ instance HsJSONPB.ToJSON OneInt where toJSON = HsJSONPB.toAesonValue toEncoding = HsJSONPB.toAesonEncoding-+ instance HsJSONPB.FromJSON OneInt where parseJSON = HsJSONPB.parseJSONPB-+ instance HsJSONPB.ToSchema OneInt where declareNamedSchema _ = do let declare_result = HsJSONPB.declareSchemaRef
grpc-haskell.cabal view
@@ -1,5 +1,5 @@ name: grpc-haskell-version: 0.0.1.0+version: 0.1.0 synopsis: Haskell implementation of gRPC layered on shared C library. homepage: https://github.com/awakenetworks/gRPC-haskell license: Apache-2.0@@ -29,10 +29,9 @@ build-depends: base >=4.8 && <5.0 , bytestring ==0.10.*- , proto3-suite >=0.4.0.0- , proto3-wire+ , proto3-suite >=0.4.2.0+ , proto3-wire >=1.2.0 , grpc-haskell-core- , async >=2.1 && <2.3 , managed >= 1.0.5 @@ -98,6 +97,7 @@ , async , bytestring == 0.10.* , containers >=0.5 && <0.7+ , deepseq , grpc-haskell , grpc-haskell-core , optparse-generic@@ -122,6 +122,7 @@ , async , bytestring == 0.10.* , containers >=0.5 && <0.7+ , deepseq , grpc-haskell , grpc-haskell-core , optparse-generic@@ -145,6 +146,7 @@ , async , bytestring == 0.10.* , containers >=0.5 && <0.7+ , deepseq , grpc-haskell , grpc-haskell-core , optparse-generic@@ -168,6 +170,7 @@ , async , bytestring == 0.10.* , containers >=0.5 && <0.7+ , deepseq , grpc-haskell , grpc-haskell-core , optparse-generic
src/Network/GRPC/HighLevel/Generated.hs view
@@ -42,6 +42,7 @@ import Network.GRPC.HighLevel.Client import Network.GRPC.LowLevel import Network.GRPC.LowLevel.Call+import Numeric.Natural import System.IO (hPutStrLn, stderr) -- | Used at the kind level as a parameter to service definitions@@ -78,6 +79,8 @@ -- ^ Security configuration. , logger :: String -> IO () -- ^ Logging function to use to log errors in handling calls.+ , serverMaxReceiveMessageLength :: Maybe Natural+ -- ^ Maximum length (in bytes) that the service may receive in a single message } defaultServiceOptions :: ServiceOptions@@ -91,6 +94,7 @@ , Network.GRPC.HighLevel.Generated.initialMetadata = mempty , Network.GRPC.HighLevel.Generated.sslConfig = Nothing , Network.GRPC.HighLevel.Generated.logger = hPutStrLn stderr+ , Network.GRPC.HighLevel.Generated.serverMaxReceiveMessageLength = Nothing } withGRPCClient :: ClientConfig -> (Client -> IO a) -> IO a
src/Network/GRPC/HighLevel/Server.hs view
@@ -13,6 +13,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL import Network.GRPC.LowLevel+import Numeric.Natural import Proto3.Suite.Class import System.IO @@ -225,6 +226,7 @@ -- ^ Security configuration. , optLogger :: String -> IO () -- ^ Logging function to use to log errors in handling calls.+ , optMaxReceiveMessageLength :: Maybe Natural } defaultOptions :: ServerOptions@@ -241,6 +243,7 @@ , optInitialMetadata = mempty , optSSLConfig = Nothing , optLogger = hPutStrLn stderr+ , optMaxReceiveMessageLength = Nothing } serverLoop :: ServerOptions -> IO ()
src/Network/GRPC/HighLevel/Server/Unregistered.hs view
@@ -122,5 +122,7 @@ [ UserAgentPrefix optUserAgentPrefix , UserAgentSuffix optUserAgentSuffix ]+ +++ foldMap (pure . MaxReceiveMessageLength) optMaxReceiveMessageLength , sslConfig = optSSLConfig }