From a2c15c5279560c45c3a039f75b3c529ab6a64bf3 Mon Sep 17 00:00:00 2001 From: Eoin Cavanagh Date: Sat, 13 Jun 2020 22:54:28 +0100 Subject: [PATCH 1/6] First cut of client/server to show a simple calculation on the server --- examples/examples.cabal | 12 +- examples/package.yaml | 5 +- examples/prepare_calcs.sh | 28 ++ examples/src/ArithClient.hs | 49 ++++ examples/src/ArithServer.hs | 69 +++++ examples/src/Proto/Protos/Calcs.hs | 343 ++++++++++++++++++++++ examples/src/Proto/Protos/Calcs_Fields.hs | 45 +++ 7 files changed, 548 insertions(+), 3 deletions(-) create mode 100755 examples/prepare_calcs.sh create mode 100644 examples/src/ArithClient.hs create mode 100644 examples/src/ArithServer.hs create mode 100644 examples/src/Proto/Protos/Calcs.hs create mode 100644 examples/src/Proto/Protos/Calcs_Fields.hs diff --git a/examples/examples.cabal b/examples/examples.cabal index 1e71636..949c056 100644 --- a/examples/examples.cabal +++ b/examples/examples.cabal @@ -1,10 +1,10 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2. +-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- --- hash: 6b8490732f6b8b92312b3d51b0bbd4ccda7081b339c78f7346f5d017c7470535 +-- hash: 0750af861e432a06ce8be50fe37d011ddb1c26490e8756b53d0d8685693d93c1 name: examples version: 0.4.0.1 @@ -28,7 +28,12 @@ source-repository head library exposed-modules: + ArithClient + ArithServer Example + LensSandBox + Proto.Protos.Calcs + Proto.Protos.Calcs_Fields Proto.Protos.Grpcbin Proto.Protos.Grpcbin_Fields other-modules: @@ -52,4 +57,7 @@ library , proto-lens , proto-lens-runtime , unliftio-core >=0.1 && <0.3 + , warp + , warp-grpc + , warp-tls default-language: Haskell2010 diff --git a/examples/package.yaml b/examples/package.yaml index 8a636be..b4d9d3e 100644 --- a/examples/package.yaml +++ b/examples/package.yaml @@ -25,12 +25,15 @@ dependencies: - http2-grpc-types >= 0.5 && < 0.6 - http-types >= 0.12 && < 0.13 - unliftio-core >= 0.1 && < 0.3 +- microlens - proto-lens-runtime - proto-lens - http2-client-grpc - http2-grpc-proto-lens - http2-client -- microlens +- warp +- warp-grpc +- warp-tls library: source-dirs: src diff --git a/examples/prepare_calcs.sh b/examples/prepare_calcs.sh new file mode 100755 index 0000000..c2a7914 --- /dev/null +++ b/examples/prepare_calcs.sh @@ -0,0 +1,28 @@ +#!/bin/bash + +#mkdir -p gen +#mkdir -p gen-bin +#mkdir -p protos + +#curl 'https://raw.githubusercontent.com/moul/pb/master/grpcbin/grpcbin.proto' > protos/grpcbin.proto + +stack install --local-bin-path=gen-bin proto-lens-protoc + +protolens="`pwd`/gen-bin/proto-lens-protoc" + +if [ -x "${protolens}" ] +then + echo "using ${protolens}" ; +else + echo "no proto-lens-protoc" + exit 2 +fi; + +protoc "--plugin=protoc-gen-haskell-protolens=${protolens}" \ + --haskell-protolens_out=./gen \ + ./protos/calcs.proto + +echo "# Generated modules:" +find gen -name "*.hs" | sed -e 's/gen\///' | sed -e 's/\.hs$//' | tr '/' '.' + +cp -r gen/* examples/src diff --git a/examples/src/ArithClient.hs b/examples/src/ArithClient.hs new file mode 100644 index 0000000..89eaf1c --- /dev/null +++ b/examples/src/ArithClient.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} + +module ArithClient where + +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) +--import Proto.Protos.Calcs (Arithmetic, CalcNumbers, CalcNumber) +import Proto.Protos.Calcs +import Proto.Protos.Calcs_Fields +import Network.GRPC.Client +import Network.HTTP2.Client +import Network.GRPC.Client.Helpers +import Network.GRPC.HTTP2.Encoding +import Lens.Micro +import Network.GRPC.HTTP2.ProtoLens + +import Data.ProtoLens + +-- create a simple CalcNumbers via lens operations +val1, val2, val3 :: CalcNumber +val1 = defMessage & (code .~ 7) +val2 = defMessage & (code .~ 77) +val3 = defMessage & (code .~ 777) + +vals :: CalcNumbers +vals = defMessage & (values .~ [val1, val2, val3]) +--- + +main :: IO () +main = do + let encoding = Encoding uncompressed + let decoding = Decoding uncompressed + let host = "127.0.0.1" + let port = 3000 + void $ runClientIO $ do + conn <- newHttp2FrameConnection host port (tlsSettings False host port) + liftIO $ print $ "connecting on port " ++ (show port) + runHttp2Client conn 8192 8192 [] defaultGoAwayHandler ignoreFallbackHandler $ \client -> do + liftIO $ putStrLn "~~~connected~~~" + let ifc = _incomingFlowControl client + let ofc = _outgoingFlowControl client + liftIO $ _addCredit ifc 10000000 + _ <- _updateWindow ifc + reply <- open client "127.0.0.1:80" [] (Timeout 100) encoding decoding + (singleRequest (RPC :: RPC Arithmetic "add") vals ) + + liftIO $ print reply + diff --git a/examples/src/ArithServer.hs b/examples/src/ArithServer.hs new file mode 100644 index 0000000..19faaaa --- /dev/null +++ b/examples/src/ArithServer.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +module ArithServer where + +import Network.GRPC.Server + +import Lens.Micro +import Lens.Micro.Extras +import Data.ProtoLens.Message (defMessage) +import Network.Wai.Handler.WarpTLS +import Network.Wai.Handler.Warp (defaultSettings, getPort) +--import Network.GRPC.HTTP2.Types (RPC(..)) +import Network.GRPC.HTTP2.ProtoLens (RPC(..)) +import Network.GRPC.HTTP2.Encoding (gzip) +import Proto.Protos.Calcs (Arithmetic, CalcNumbers, CalcNumber) +import Proto.Protos.Calcs_Fields +import System.Environment (getArgs) + +-- Eoin Cavanagh, modified from https://github.com/lucasdicioccio/warp-grpc-example/blob/master/src/Lib.hs + +--main :: IO () +--main = do +-- args <- getArgs +-- runGrpc defaultTlsSettings defaultSettings (handlers args) [gzip] + +someFunc :: IO () +someFunc = do + args <- getArgs + someFunc' args + +someFunc' :: [String] -> IO () +someFunc' p = do + print $ "starting on port " ++ ((show . getPort) defaultSettings) + -- for simplicity, configures Warp to support insecure sessions + -- not recommended for production use + let insecureTlsSettings = defaultTlsSettings { onInsecure = AllowInsecure } + runGrpc insecureTlsSettings defaultSettings (handlers p) [gzip] + + +handlers :: [String] -> [ServiceHandler] +handlers _ = + [unary (RPC :: RPC Arithmetic "add") handleAdd + ] + + +-- sum up the values provided in the request and return the total +-- stubbed at the moment +handleAdd :: UnaryHandler IO CalcNumbers CalcNumber +handleAdd _ input = do + print ("add"::[Char], view values input) + let xs = view values input + print (show xs) + --let xs' = (xs (^..) $ traversed . code) :: [Int] + -- let xs' = (map code xs) + -- let s = sum xs + -- return $ defMessage & code .~ (head (view values input)) + return $ performAdd input + + +performAdd :: CalcNumbers -> CalcNumber +performAdd nums = defMessage & code .~ total + where + nums' = view values nums + total = sum (fmap (\l -> l ^. code) nums') + + + + diff --git a/examples/src/Proto/Protos/Calcs.hs b/examples/src/Proto/Protos/Calcs.hs new file mode 100644 index 0000000..d7c6f06 --- /dev/null +++ b/examples/src/Proto/Protos/Calcs.hs @@ -0,0 +1,343 @@ +{- This file was auto-generated from protos/calcs.proto by the proto-lens-protoc program. -} +{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, UndecidableInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds, BangPatterns, TypeApplications, OverloadedStrings, DerivingStrategies#-} +{-# OPTIONS_GHC -Wno-unused-imports#-} +{-# OPTIONS_GHC -Wno-duplicate-exports#-} +{-# OPTIONS_GHC -Wno-dodgy-exports#-} +module Proto.Protos.Calcs ( + Arithmetic(..), CalcNumber(), CalcNumbers() + ) where +import qualified Data.ProtoLens.Runtime.Control.DeepSeq as Control.DeepSeq +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Prism as Data.ProtoLens.Prism +import qualified Data.ProtoLens.Runtime.Prelude as Prelude +import qualified Data.ProtoLens.Runtime.Data.Int as Data.Int +import qualified Data.ProtoLens.Runtime.Data.Monoid as Data.Monoid +import qualified Data.ProtoLens.Runtime.Data.Word as Data.Word +import qualified Data.ProtoLens.Runtime.Data.ProtoLens as Data.ProtoLens +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Bytes as Data.ProtoLens.Encoding.Bytes +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Growing as Data.ProtoLens.Encoding.Growing +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Parser.Unsafe as Data.ProtoLens.Encoding.Parser.Unsafe +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire as Data.ProtoLens.Encoding.Wire +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Field as Data.ProtoLens.Field +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Message.Enum as Data.ProtoLens.Message.Enum +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Service.Types as Data.ProtoLens.Service.Types +import qualified Data.ProtoLens.Runtime.Lens.Family2 as Lens.Family2 +import qualified Data.ProtoLens.Runtime.Lens.Family2.Unchecked as Lens.Family2.Unchecked +import qualified Data.ProtoLens.Runtime.Data.Text as Data.Text +import qualified Data.ProtoLens.Runtime.Data.Map as Data.Map +import qualified Data.ProtoLens.Runtime.Data.ByteString as Data.ByteString +import qualified Data.ProtoLens.Runtime.Data.ByteString.Char8 as Data.ByteString.Char8 +import qualified Data.ProtoLens.Runtime.Data.Text.Encoding as Data.Text.Encoding +import qualified Data.ProtoLens.Runtime.Data.Vector as Data.Vector +import qualified Data.ProtoLens.Runtime.Data.Vector.Generic as Data.Vector.Generic +import qualified Data.ProtoLens.Runtime.Data.Vector.Unboxed as Data.Vector.Unboxed +import qualified Data.ProtoLens.Runtime.Text.Read as Text.Read +{- | Fields : + + * 'Proto.Protos.Calcs_Fields.code' @:: Lens' CalcNumber Data.Word.Word32@ -} +data CalcNumber + = CalcNumber'_constructor {_CalcNumber'code :: !Data.Word.Word32, + _CalcNumber'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show CalcNumber where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +instance Data.ProtoLens.Field.HasField CalcNumber "code" Data.Word.Word32 where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _CalcNumber'code (\ x__ y__ -> x__ {_CalcNumber'code = y__})) + Prelude.id +instance Data.ProtoLens.Message CalcNumber where + messageName _ = Data.Text.pack "calcs.CalcNumber" + packedMessageDescriptor _ + = "\n\ + \\n\ + \CalcNumber\DC2\DC2\n\ + \\EOTcode\CAN\SOH \SOH(\rR\EOTcode" + packedFileDescriptor _ = packedFileDescriptor + 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 (Data.ProtoLens.Field.field @"code")) :: + Data.ProtoLens.FieldDescriptor CalcNumber + in + Data.Map.fromList [(Data.ProtoLens.Tag 1, code__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _CalcNumber'_unknownFields + (\ x__ y__ -> x__ {_CalcNumber'_unknownFields = y__}) + defMessage + = CalcNumber'_constructor + {_CalcNumber'code = Data.ProtoLens.fieldDefault, + _CalcNumber'_unknownFields = []} + parseMessage + = let + loop :: + CalcNumber -> Data.ProtoLens.Encoding.Bytes.Parser CalcNumber + loop x + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 8 -> do y <- (Data.ProtoLens.Encoding.Bytes.) + (Prelude.fmap + Prelude.fromIntegral + Data.ProtoLens.Encoding.Bytes.getVarInt) + "code" + loop (Lens.Family2.set (Data.ProtoLens.Field.field @"code") y x) + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + in + (Data.ProtoLens.Encoding.Bytes.) + (do loop Data.ProtoLens.defMessage) "CalcNumber" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"code") _x + in + if (Prelude.==) _v Data.ProtoLens.fieldDefault then + Data.Monoid.mempty + else + (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 8) + ((Prelude..) + Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)) +instance Control.DeepSeq.NFData CalcNumber where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_CalcNumber'_unknownFields x__) + (Control.DeepSeq.deepseq (_CalcNumber'code x__) ()) +{- | Fields : + + * 'Proto.Protos.Calcs_Fields.values' @:: Lens' CalcNumbers [CalcNumber]@ + * 'Proto.Protos.Calcs_Fields.vec'values' @:: Lens' CalcNumbers (Data.Vector.Vector CalcNumber)@ -} +data CalcNumbers + = CalcNumbers'_constructor {_CalcNumbers'values :: !(Data.Vector.Vector CalcNumber), + _CalcNumbers'_unknownFields :: !Data.ProtoLens.FieldSet} + deriving stock (Prelude.Eq, Prelude.Ord) +instance Prelude.Show CalcNumbers where + showsPrec _ __x __s + = Prelude.showChar + '{' + (Prelude.showString + (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s)) +instance Data.ProtoLens.Field.HasField CalcNumbers "values" [CalcNumber] where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _CalcNumbers'values (\ x__ y__ -> x__ {_CalcNumbers'values = y__})) + (Lens.Family2.Unchecked.lens + Data.Vector.Generic.toList + (\ _ y__ -> Data.Vector.Generic.fromList y__)) +instance Data.ProtoLens.Field.HasField CalcNumbers "vec'values" (Data.Vector.Vector CalcNumber) where + fieldOf _ + = (Prelude..) + (Lens.Family2.Unchecked.lens + _CalcNumbers'values (\ x__ y__ -> x__ {_CalcNumbers'values = y__})) + Prelude.id +instance Data.ProtoLens.Message CalcNumbers where + messageName _ = Data.Text.pack "calcs.CalcNumbers" + packedMessageDescriptor _ + = "\n\ + \\vCalcNumbers\DC2)\n\ + \\ACKvalues\CAN\SOH \ETX(\v2\DC1.calcs.CalcNumberR\ACKvalues" + packedFileDescriptor _ = packedFileDescriptor + fieldsByTag + = let + values__field_descriptor + = Data.ProtoLens.FieldDescriptor + "values" + (Data.ProtoLens.MessageField Data.ProtoLens.MessageType :: + Data.ProtoLens.FieldTypeDescriptor CalcNumber) + (Data.ProtoLens.RepeatedField + Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"values")) :: + Data.ProtoLens.FieldDescriptor CalcNumbers + in + Data.Map.fromList + [(Data.ProtoLens.Tag 1, values__field_descriptor)] + unknownFields + = Lens.Family2.Unchecked.lens + _CalcNumbers'_unknownFields + (\ x__ y__ -> x__ {_CalcNumbers'_unknownFields = y__}) + defMessage + = CalcNumbers'_constructor + {_CalcNumbers'values = Data.Vector.Generic.empty, + _CalcNumbers'_unknownFields = []} + parseMessage + = let + loop :: + CalcNumbers + -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld CalcNumber + -> Data.ProtoLens.Encoding.Bytes.Parser CalcNumbers + loop x mutable'values + = do end <- Data.ProtoLens.Encoding.Bytes.atEnd + if end then + do frozen'values <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.unsafeFreeze + mutable'values) + (let missing = [] + in + if Prelude.null missing then + Prelude.return () + else + Prelude.fail + ((Prelude.++) + "Missing required fields: " + (Prelude.show (missing :: [Prelude.String])))) + Prelude.return + (Lens.Family2.over + Data.ProtoLens.unknownFields + (\ !t -> Prelude.reverse t) + (Lens.Family2.set + (Data.ProtoLens.Field.field @"vec'values") frozen'values x)) + else + do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt + case tag of + 10 + -> do !y <- (Data.ProtoLens.Encoding.Bytes.) + (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt + Data.ProtoLens.Encoding.Bytes.isolate + (Prelude.fromIntegral len) + Data.ProtoLens.parseMessage) + "values" + v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + (Data.ProtoLens.Encoding.Growing.append mutable'values y) + loop x v + wire + -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire + wire + loop + (Lens.Family2.over + Data.ProtoLens.unknownFields (\ !t -> (:) y t) x) + mutable'values + in + (Data.ProtoLens.Encoding.Bytes.) + (do mutable'values <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO + Data.ProtoLens.Encoding.Growing.new + loop Data.ProtoLens.defMessage mutable'values) + "CalcNumbers" + buildMessage + = \ _x + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.foldMapBuilder + (\ _v + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt 10) + ((Prelude..) + (\ bs + -> (Data.Monoid.<>) + (Data.ProtoLens.Encoding.Bytes.putVarInt + (Prelude.fromIntegral (Data.ByteString.length bs))) + (Data.ProtoLens.Encoding.Bytes.putBytes bs)) + Data.ProtoLens.encodeMessage + _v)) + (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'values") _x)) + (Data.ProtoLens.Encoding.Wire.buildFieldSet + (Lens.Family2.view Data.ProtoLens.unknownFields _x)) +instance Control.DeepSeq.NFData CalcNumbers where + rnf + = \ x__ + -> Control.DeepSeq.deepseq + (_CalcNumbers'_unknownFields x__) + (Control.DeepSeq.deepseq (_CalcNumbers'values x__) ()) +data Arithmetic = Arithmetic {} +instance Data.ProtoLens.Service.Types.Service Arithmetic where + type ServiceName Arithmetic = "Arithmetic" + type ServicePackage Arithmetic = "calcs" + type ServiceMethods Arithmetic = '["add"] +instance Data.ProtoLens.Service.Types.HasMethodImpl Arithmetic "add" where + type MethodName Arithmetic "add" = "Add" + type MethodInput Arithmetic "add" = CalcNumbers + type MethodOutput Arithmetic "add" = CalcNumber + type MethodStreamingType Arithmetic "add" = 'Data.ProtoLens.Service.Types.NonStreaming +packedFileDescriptor :: Data.ByteString.ByteString +packedFileDescriptor + = "\n\ + \\DC2protos/calcs.proto\DC2\ENQcalcs\"8\n\ + \\vCalcNumbers\DC2)\n\ + \\ACKvalues\CAN\SOH \ETX(\v2\DC1.calcs.CalcNumberR\ACKvalues\" \n\ + \\n\ + \CalcNumber\DC2\DC2\n\ + \\EOTcode\CAN\SOH \SOH(\rR\EOTcode2<\n\ + \\n\ + \Arithmetic\DC2.\n\ + \\ETXAdd\DC2\DC2.calcs.CalcNumbers\SUB\DC1.calcs.CalcNumber\"\NULJ\151\STX\n\ + \\ACK\DC2\EOT\NUL\NUL\SO\SOH\n\ + \\b\n\ + \\SOH\f\DC2\ETX\NUL\NUL\DC2\n\ + \\b\n\ + \\SOH\STX\DC2\ETX\STX\NUL\SO\n\ + \\n\ + \\n\ + \\STX\ACK\NUL\DC2\EOT\EOT\NUL\ACK\SOH\n\ + \\n\ + \\n\ + \\ETX\ACK\NUL\SOH\DC2\ETX\EOT\b\DC2\n\ + \\v\n\ + \\EOT\ACK\NUL\STX\NUL\DC2\ETX\ENQ\STX.\n\ + \\f\n\ + \\ENQ\ACK\NUL\STX\NUL\SOH\DC2\ETX\ENQ\ACK\t\n\ + \\f\n\ + \\ENQ\ACK\NUL\STX\NUL\STX\DC2\ETX\ENQ\n\ + \\NAK\n\ + \\f\n\ + \\ENQ\ACK\NUL\STX\NUL\ETX\DC2\ETX\ENQ *\n\ + \\n\ + \\n\ + \\STX\EOT\NUL\DC2\EOT\b\NUL\n\ + \\ETX\n\ + \\n\ + \\n\ + \\ETX\EOT\NUL\SOH\DC2\ETX\b\b\DC3\n\ + \\v\n\ + \\EOT\EOT\NUL\STX\NUL\DC2\ETX\t\EOT#\n\ + \\f\n\ + \\ENQ\EOT\NUL\STX\NUL\EOT\DC2\ETX\t\EOT\f\n\ + \\f\n\ + \\ENQ\EOT\NUL\STX\NUL\ACK\DC2\ETX\t\r\ETB\n\ + \\f\n\ + \\ENQ\EOT\NUL\STX\NUL\SOH\DC2\ETX\t\CAN\RS\n\ + \\f\n\ + \\ENQ\EOT\NUL\STX\NUL\ETX\DC2\ETX\t!\"\n\ + \\n\ + \\n\ + \\STX\EOT\SOH\DC2\EOT\f\NUL\SO\SOH\n\ + \\n\ + \\n\ + \\ETX\EOT\SOH\SOH\DC2\ETX\f\b\DC2\n\ + \\v\n\ + \\EOT\EOT\SOH\STX\NUL\DC2\ETX\r\STX\DC2\n\ + \\f\n\ + \\ENQ\EOT\SOH\STX\NUL\ENQ\DC2\ETX\r\STX\b\n\ + \\f\n\ + \\ENQ\EOT\SOH\STX\NUL\SOH\DC2\ETX\r\t\r\n\ + \\f\n\ + \\ENQ\EOT\SOH\STX\NUL\ETX\DC2\ETX\r\DLE\DC1b\ACKproto3" \ No newline at end of file diff --git a/examples/src/Proto/Protos/Calcs_Fields.hs b/examples/src/Proto/Protos/Calcs_Fields.hs new file mode 100644 index 0000000..a5aeeb0 --- /dev/null +++ b/examples/src/Proto/Protos/Calcs_Fields.hs @@ -0,0 +1,45 @@ +{- This file was auto-generated from protos/calcs.proto by the proto-lens-protoc program. -} +{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, UndecidableInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds, BangPatterns, TypeApplications, OverloadedStrings, DerivingStrategies#-} +{-# OPTIONS_GHC -Wno-unused-imports#-} +{-# OPTIONS_GHC -Wno-duplicate-exports#-} +{-# OPTIONS_GHC -Wno-dodgy-exports#-} +module Proto.Protos.Calcs_Fields where +import qualified Data.ProtoLens.Runtime.Prelude as Prelude +import qualified Data.ProtoLens.Runtime.Data.Int as Data.Int +import qualified Data.ProtoLens.Runtime.Data.Monoid as Data.Monoid +import qualified Data.ProtoLens.Runtime.Data.Word as Data.Word +import qualified Data.ProtoLens.Runtime.Data.ProtoLens as Data.ProtoLens +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Bytes as Data.ProtoLens.Encoding.Bytes +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Growing as Data.ProtoLens.Encoding.Growing +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Parser.Unsafe as Data.ProtoLens.Encoding.Parser.Unsafe +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire as Data.ProtoLens.Encoding.Wire +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Field as Data.ProtoLens.Field +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Message.Enum as Data.ProtoLens.Message.Enum +import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Service.Types as Data.ProtoLens.Service.Types +import qualified Data.ProtoLens.Runtime.Lens.Family2 as Lens.Family2 +import qualified Data.ProtoLens.Runtime.Lens.Family2.Unchecked as Lens.Family2.Unchecked +import qualified Data.ProtoLens.Runtime.Data.Text as Data.Text +import qualified Data.ProtoLens.Runtime.Data.Map as Data.Map +import qualified Data.ProtoLens.Runtime.Data.ByteString as Data.ByteString +import qualified Data.ProtoLens.Runtime.Data.ByteString.Char8 as Data.ByteString.Char8 +import qualified Data.ProtoLens.Runtime.Data.Text.Encoding as Data.Text.Encoding +import qualified Data.ProtoLens.Runtime.Data.Vector as Data.Vector +import qualified Data.ProtoLens.Runtime.Data.Vector.Generic as Data.Vector.Generic +import qualified Data.ProtoLens.Runtime.Data.Vector.Unboxed as Data.Vector.Unboxed +import qualified Data.ProtoLens.Runtime.Text.Read as Text.Read +code :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "code" a) => + Lens.Family2.LensLike' f s a +code = Data.ProtoLens.Field.field @"code" +values :: + forall f s a. + (Prelude.Functor f, Data.ProtoLens.Field.HasField s "values" a) => + Lens.Family2.LensLike' f s a +values = Data.ProtoLens.Field.field @"values" +vec'values :: + forall f s a. + (Prelude.Functor f, + Data.ProtoLens.Field.HasField s "vec'values" a) => + Lens.Family2.LensLike' f s a +vec'values = Data.ProtoLens.Field.field @"vec'values" \ No newline at end of file From c2050205fdee554925bf31cb5f4ec727c708e809 Mon Sep 17 00:00:00 2001 From: Eoin Cavanagh Date: Sat, 13 Jun 2020 23:00:57 +0100 Subject: [PATCH 2/6] some clean up --- examples/src/ArithClient.hs | 5 ++--- examples/src/ArithServer.hs | 25 ++++--------------------- 2 files changed, 6 insertions(+), 24 deletions(-) diff --git a/examples/src/ArithClient.hs b/examples/src/ArithClient.hs index 89eaf1c..692cf6a 100644 --- a/examples/src/ArithClient.hs +++ b/examples/src/ArithClient.hs @@ -5,7 +5,6 @@ module ArithClient where import Control.Monad (void) import Control.Monad.IO.Class (liftIO) ---import Proto.Protos.Calcs (Arithmetic, CalcNumbers, CalcNumber) import Proto.Protos.Calcs import Proto.Protos.Calcs_Fields import Network.GRPC.Client @@ -17,7 +16,7 @@ import Network.GRPC.HTTP2.ProtoLens import Data.ProtoLens --- create a simple CalcNumbers via lens operations +-- create a simple CalcNumbers via lens operations for later use val1, val2, val3 :: CalcNumber val1 = defMessage & (code .~ 7) val2 = defMessage & (code .~ 77) @@ -42,7 +41,7 @@ main = do let ofc = _outgoingFlowControl client liftIO $ _addCredit ifc 10000000 _ <- _updateWindow ifc - reply <- open client "127.0.0.1:80" [] (Timeout 100) encoding decoding + reply <- open client "127.0.0.1" [] (Timeout 100) encoding decoding (singleRequest (RPC :: RPC Arithmetic "add") vals ) liftIO $ print reply diff --git a/examples/src/ArithServer.hs b/examples/src/ArithServer.hs index 19faaaa..c55f3e9 100644 --- a/examples/src/ArithServer.hs +++ b/examples/src/ArithServer.hs @@ -4,26 +4,19 @@ module ArithServer where import Network.GRPC.Server - import Lens.Micro import Lens.Micro.Extras import Data.ProtoLens.Message (defMessage) import Network.Wai.Handler.WarpTLS import Network.Wai.Handler.Warp (defaultSettings, getPort) ---import Network.GRPC.HTTP2.Types (RPC(..)) import Network.GRPC.HTTP2.ProtoLens (RPC(..)) import Network.GRPC.HTTP2.Encoding (gzip) import Proto.Protos.Calcs (Arithmetic, CalcNumbers, CalcNumber) import Proto.Protos.Calcs_Fields import System.Environment (getArgs) - + -- Eoin Cavanagh, modified from https://github.com/lucasdicioccio/warp-grpc-example/blob/master/src/Lib.hs ---main :: IO () ---main = do --- args <- getArgs --- runGrpc defaultTlsSettings defaultSettings (handlers args) [gzip] - someFunc :: IO () someFunc = do args <- getArgs @@ -37,7 +30,6 @@ someFunc' p = do let insecureTlsSettings = defaultTlsSettings { onInsecure = AllowInsecure } runGrpc insecureTlsSettings defaultSettings (handlers p) [gzip] - handlers :: [String] -> [ServiceHandler] handlers _ = [unary (RPC :: RPC Arithmetic "add") handleAdd @@ -45,25 +37,16 @@ handlers _ = -- sum up the values provided in the request and return the total --- stubbed at the moment handleAdd :: UnaryHandler IO CalcNumbers CalcNumber handleAdd _ input = do - print ("add"::[Char], view values input) - let xs = view values input - print (show xs) - --let xs' = (xs (^..) $ traversed . code) :: [Int] - -- let xs' = (map code xs) - -- let s = sum xs - -- return $ defMessage & code .~ (head (view values input)) + let vals = view values input + print ("add"::[Char], vals) + print (show vals) return $ performAdd input - performAdd :: CalcNumbers -> CalcNumber performAdd nums = defMessage & code .~ total where nums' = view values nums total = sum (fmap (\l -> l ^. code) nums') - - - From bcf6ec68dbf5b5e5b3a8a4ae3ad959e7d186de1c Mon Sep 17 00:00:00 2001 From: Eoin Cavanagh Date: Sun, 14 Jun 2020 23:01:52 +0100 Subject: [PATCH 3/6] added proto file --- examples/examples.cabal | 3 +-- examples/protos/calcs.proto | 16 ++++++++++++++++ 2 files changed, 17 insertions(+), 2 deletions(-) create mode 100644 examples/protos/calcs.proto diff --git a/examples/examples.cabal b/examples/examples.cabal index 949c056..c287f83 100644 --- a/examples/examples.cabal +++ b/examples/examples.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0750af861e432a06ce8be50fe37d011ddb1c26490e8756b53d0d8685693d93c1 +-- hash: 59e86b4638bab931cb9948900fd08b2b735376fb44120e9889d1af96262ce663 name: examples version: 0.4.0.1 @@ -31,7 +31,6 @@ library ArithClient ArithServer Example - LensSandBox Proto.Protos.Calcs Proto.Protos.Calcs_Fields Proto.Protos.Grpcbin diff --git a/examples/protos/calcs.proto b/examples/protos/calcs.proto new file mode 100644 index 0000000..6f90c03 --- /dev/null +++ b/examples/protos/calcs.proto @@ -0,0 +1,16 @@ +syntax = "proto3"; + +package calcs; + +service Arithmetic { + rpc Add(CalcNumbers) returns (CalcNumber) {} +} + +message CalcNumbers { + repeated CalcNumber values = 1; + } + +message CalcNumber { + uint32 code = 1; +} + From f015f269477a7976e3bcaad2bbf663628ec61263 Mon Sep 17 00:00:00 2001 From: Eoin Cavanagh Date: Mon, 15 Jun 2020 23:09:14 +0100 Subject: [PATCH 4/6] make summation in server more lens-like --- examples/src/ArithServer.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/examples/src/ArithServer.hs b/examples/src/ArithServer.hs index c55f3e9..0addb47 100644 --- a/examples/src/ArithServer.hs +++ b/examples/src/ArithServer.hs @@ -47,6 +47,5 @@ handleAdd _ input = do performAdd :: CalcNumbers -> CalcNumber performAdd nums = defMessage & code .~ total where - nums' = view values nums - total = sum (fmap (\l -> l ^. code) nums') + total = sum (toListOf (values . traverse . code) nums) From afeb8c976596915a18e64e5d5c548df67428a3bb Mon Sep 17 00:00:00 2001 From: Eoin Cavanagh Date: Mon, 15 Jun 2020 23:35:55 +0100 Subject: [PATCH 5/6] first draft of README --- examples/README.md | 50 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 examples/README.md diff --git a/examples/README.md b/examples/README.md new file mode 100644 index 0000000..ed94a78 --- /dev/null +++ b/examples/README.md @@ -0,0 +1,50 @@ +# A Simple GRPC Client/Server in Haskell +This directory contains a simple Client/Server example with a single RPC call. +The Client calls the server with a list of numbers, and the server sums up these numbers and sends the answer back to the client. + +# The Protobuf Definition +The protobuf definition is in a single file, *calcs.proto*. +``` +syntax = "proto3"; + +package calcs; + +service Arithmetic { + rpc Add(CalcNumbers) returns (CalcNumber) {} +} + +message CalcNumbers { + repeated CalcNumber values = 1; + } + +message CalcNumber { + uint32 code = 1; +} +``` + +Each RPC call takes a single message, and returns a single message. In this case the request is a *CalcNumbers* and the response is a *CalcNumber*. Protobuf allows message types to be nested. In this case *CalcHumbers* is comprised of a list of *CalcNumber* values. *CalcNumber* itself is a [32 bit unsigned int](https://developers.google.com/protocol-buffers/docs/proto3#scalar_value_types). + +# Getting it working +The *calcs.proto* definition file is used to generate Haskell code via the *protoc* tool, which needs to be installed separately. There are two Haskell files generated. The simplest way to build the client and server is to copy these generaeted source files to somewhere accessible within your stack package. + +## Starting the Server +The server is in ArithServer.hs, and can be started from *ghci*. + +~~~ +stack ghci +:l ArithServer +someFunc' [] +~~~ + +This starts the server on port 3000. + +## Starting the Client +The client is ArithClient.hs and can be started as shown below: + +~~~ +stack ghci +ArithClient.main +~~~ + +The client sends a single request to the server, processes the response and terminates. +Both Client and server should output some logging to show th \ No newline at end of file From 55bf6a2ef42cabec214da764a0be3a75d3a9b9c8 Mon Sep 17 00:00:00 2001 From: Eoin Cavanagh Date: Mon, 15 Jun 2020 23:37:25 +0100 Subject: [PATCH 6/6] typo in README --- examples/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/README.md b/examples/README.md index ed94a78..1c7d44c 100644 --- a/examples/README.md +++ b/examples/README.md @@ -47,4 +47,4 @@ ArithClient.main ~~~ The client sends a single request to the server, processes the response and terminates. -Both Client and server should output some logging to show th \ No newline at end of file +Both client and server output a few log lines to show what is happening. \ No newline at end of file