A Simple Example. about http2-grpc-haskell HOT 2 CLOSED

data GenericRPC =
  GenericRPC {
    service :: ByteString,
    method :: ByteString
  }
  deriving (Eq, Show)

instance IsRPC GenericRPC where
  path rpc = "/" <> service rpc <> "/" <> method rpc

GenericRPC "Greeter" "SayHello"

Right (Right ([(":status","200"),("content-type","application/grpc+proto"),("trailer","Grpc-Status"),("trailer","Grpc-Message"),("trailer","Grpc-Status-Details-Bin")],Just [("grpc-message","unknown service Greeter"),("grpc-status","12")],Left "not enough bytes"))        

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

syntax = "proto3";

package default.v1;

service Greeter {
  rpc SayHello(HelloRequest) returns (HelloResponse) {}
}

message HelloRequest {
  string content = 1;
}

message HelloResponse {
  string content = 1;
}

import qualified Network.GRPC.Client            as GC
import qualified Network.HTTP2.Client           as HC
import qualified Network.GRPC.Client.Helpers    as GCH
import Network.GRPC.Client.Helpers              (GrpcClient)
import qualified Data.ProtoLens.Message         as PLM
import Network.HTTP2.Client.Exceptions          (ClientIO)
import qualified Proto.Greeter                  as PD
import qualified Proto.Greeter_Fields           as PDF
import Proto.Greeter                            (Greeter(..))
import Control.Monad.IO.Class                   (liftIO)
import qualified RPC                            as R
import RPC                                      (GenericRPC)
import           Proto.Greeter                  ( Greeter(..)
                                                , HelloRequest(..)
                                                , HelloResponse(..)
                                                )
import Network.GRPC.HTTP2.Types                 (IsRPC(..))


mkClient :: ClientIO GrpcClient
mkClient = GCH.setupGrpcClient $ GCH.grpcClientConfigSimple "127.0.0.1" 8000 True


runClient :: ClientIO ()
runClient = do
  client <- mkClient
  ret <- (GCH.rawUnary sayHelloRPC client request) :: ClientIO (Either HC.TooMuchConcurrency (GC.RawReply HelloResponse))
  liftIO $ print ret
  return ()
  where
    sayHelloRPC = R.createRPC "Greeter" "SayHello"
    request :: HelloRequest
    request = R.createHelloRequest "CLIENT REQUEST"

{-# LANGUAGE OverloadedStrings #-}


import qualified Network.GRPC.Server            as S
import Network.GRPC.Server                      ( ServiceHandler
                                                , UnaryHandler
                                                )
import qualified Network.Wai.Handler.WarpTLS    as WT
import Network.Wai.Handler.WarpTLS              (TLSSettings)
import qualified Network.Wai.Handler.Warp       as W
import Network.Wai.Handler.Warp                 (Settings)
import qualified Proto.Greeter                  as PD
import qualified Proto.Greeter_Fields           as PDF
import Proto.Greeter                            (Greeter(..))
import Data.ProtoLens.Message                   as PLM
import qualified Network.GRPC.HTTP2.Encoding    as GE
import qualified RPC                            as R
import RPC                                      (GenericRPC)
import           Proto.Greeter                  ( Greeter(..)
                                                , HelloRequest(..)
                                                , HelloResponse(..)
                                                )



-- Some useful data types.
type TLSKeyPath = FilePath
type TLSCertPath = FilePath


-- Create a custom tls certificate given path to the key and certificate.
loadTlsSettings :: TLSCertPath -> TLSKeyPath -> TLSSettings
loadTlsSettings = WT.tlsSettings


-- Create a default tls certificate.
defaultTlsSettings :: TLSSettings
defaultTlsSettings = loadTlsSettings cp kp
  where
    kp = "/path/to/key.pem"
    cp = "/path/to/certificate.pem"


-- Create a default warp setting.
defaultWarpSetting :: Settings
defaultWarpSetting = W.setHost "127.0.0.1" $ W.setPort 8000 W.defaultSettings


-- Create a set of handlers.
handlers :: [ServiceHandler]
handlers =
  [ S.unary sayHelloRPC handleSayHello
  ]
  where
    sayHelloRPC = R.createRPC "Greeter" "SayHello"


handleSayHello :: UnaryHandler HelloRequest HelloResponse
handleSayHello _ input = do
  print ("sayHello")
  print $ show input
  return $ R.createHelloResponse "SERVER RESPONSE"


-- Start a grpc server.
runServer :: IO ()
runServer = do
  print "Server Started"
  runGrpc defaultTlsSettings defaultWarpSetting handlers [GE.gzip]
  print "Server Terminated"

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLabels #-}


import           Data.ByteString                (ByteString)
import qualified Data.ByteString                as BS
import qualified Data.ByteString.Lazy           as BL
import           Data.ByteString.Builder        (Builder)
import           Proto3.Wire                    as W
import qualified Proto3.Wire.Encode             as Enc
import qualified Proto3.Wire.Decode             as Dec
import qualified Proto.Greeter_Fields           as PDF
import qualified Proto.Greeter                  as PD
import qualified Data.Monoid                    as MND
import           Proto.Greeter                  ( Greeter(..)
                                                , HelloRequest(..)
                                                , HelloResponse(..)
                                                )
import Network.GRPC.HTTP2.Encoding              ( GRPCInput(..)
                                                , GRPCOutput(..)
                                                , Compression(..)
                                                , Decoder
                                                )
import Network.GRPC.HTTP2.Types                 (IsRPC(..))
import qualified Data.Binary.Get                as BG
import           Data.Binary.Builder            as BB
import           Data.Bifunctor                 as BF
import qualified Data.ProtoLens.Labels          as PLL
import           Lens.Micro                     ( (^.)
                                                , (&)
                                                , (.~)
                                                )
import qualified Data.ProtoLens.Message         as PLM
import qualified Data.Text.Lazy                 as TL

-- A representation of an RPC.
data GenericRPC =
  GenericRPC {
    service :: ByteString,
    method :: ByteString
  }
  deriving (Eq, Show)


createRPC :: ByteString -> ByteString -> GenericRPC
createRPC = GenericRPC


instance IsRPC GenericRPC where
  path rpc = "/" <> service rpc <> "/" <> method rpc


-- Encoder and Decoder
class GenericEncoder a where
  encode :: a -> Enc.MessageBuilder
  decode :: Dec.Parser Dec.RawMessage a


instance GenericEncoder a => GRPCInput GenericRPC a where
  encodeInput _ = genericEncode
  decodeInput _ = genericDecode


instance GenericEncoder a => GRPCOutput GenericRPC a where
  encodeOutput _ = genericEncode
  decodeOutput _ = genericDecode


genericEncode :: GenericEncoder m => Compression -> m -> Builder
genericEncode compression plain =
    mconcat [ BB.singleton (if _compressionByteSet compression then 1 else 0)
            , BB.putWord32be (fromIntegral $ BS.length bin)
            , BB.fromByteString bin
            ]
  where
    bin = _compressionFunction compression $ BL.toStrict $ Enc.toLazyByteString (encode plain)


genericDecode :: GenericEncoder m => Compression -> Decoder (Either String m)
genericDecode compression =
  BG.runGetIncremental $ do
    isCompressed <- BG.getInt8
    let decompress = if isCompressed == 0 then pure else _decompressionFunction compression
    n <- BG.getWord32be
    BF.first show . Dec.parse decode <$> (decompress =<< BG.getByteString (fromIntegral n))


createHelloRequest :: TL.Text -> HelloRequest
createHelloRequest c =
  PLM.defMessage
    & #content .~ (TL.toStrict c)


createHelloResponse :: TL.Text -> HelloResponse
createHelloResponse c =
  PLM.defMessage
    & #content .~ (TL.toStrict c)


-- Making concrete encode and decode methods.
instance GenericEncoder HelloRequest where
  encode r = Enc.text 1 . TL.fromStrict $ r ^. #content
  decode = createHelloRequest <$> (Dec.one Dec.text MND.mempty `Dec.at` 1)


-- Making concrete encode and decode methods.
instance GenericEncoder HelloResponse where
  encode r = Enc.text 1 . TL.fromStrict $ r ^. #content
  decode = createHelloResponse <$> (Dec.one Dec.text MND.mempty `Dec.at` 1)