mu-grpc-client 0.1.0.0 → 0.2.0.0
raw patch · 6 files changed
+352/−138 lines, 6 filesdep +http2-grpc-typesdep +mu-grpc-commondep +mu-opticsdep −http2-grpc-proto3-wiredep ~mu-protobufdep ~mu-rpcdep ~mu-schemanew-uploader
Dependencies added: http2-grpc-types, mu-grpc-common, mu-optics, optics-core
Dependencies removed: http2-grpc-proto3-wire
Dependency ranges changed: mu-protobuf, mu-rpc, mu-schema
Files
- mu-grpc-client.cabal +50/−41
- src/Mu/GRpc/Client/Examples.hs +2/−2
- src/Mu/GRpc/Client/Internal.hs +108/−69
- src/Mu/GRpc/Client/Optics.hs +161/−0
- src/Mu/GRpc/Client/Record.hs +25/−22
- src/Mu/GRpc/Client/TyApps.hs +6/−4
mu-grpc-client.cabal view
@@ -1,47 +1,56 @@-cabal-version: >=1.10-name: mu-grpc-client-version: 0.1.0.0-synopsis: gRPC clients from Mu definitions-description: With @mu-grpc-client@ you can easily build gRPC clients for mu-haskell!-license: Apache-2.0-license-file: LICENSE-author: Alejandro Serrano, Flavio Corpa-maintainer: alejandro.serrano@47deg.com-copyright: Copyright © 2019-2020 <http://47deg.com 47 Degrees>-category: Network-build-type: Simple-extra-source-files: CHANGELOG.md-homepage: https://higherkindness.io/mu-haskell/-bug-reports: https://github.com/higherkindness/mu-haskell/issues+name: mu-grpc-client+version: 0.2.0.0+synopsis: gRPC clients from Mu definitions+description:+ With @mu-grpc-client@ you can easily build gRPC clients for mu-haskell! +license: Apache-2.0+license-file: LICENSE+author: Alejandro Serrano, Flavio Corpa+maintainer: alejandro.serrano@47deg.com+copyright: Copyright © 2019-2020 <http://47deg.com 47 Degrees>+category: Network+build-type: Simple+cabal-version: >=1.10+extra-source-files: CHANGELOG.md+homepage: https://higherkindness.io/mu-haskell/+bug-reports: https://github.com/higherkindness/mu-haskell/issues+ source-repository head type: git location: https://github.com/higherkindness/mu-haskell library- exposed-modules: Mu.GRpc.Client.TyApps,- Mu.GRpc.Client.Record,- Mu.GRpc.Client.Examples- other-modules: Mu.GRpc.Client.Internal- build-depends: base >=4.12 && <5- , async- , bytestring- , conduit- , http2- , http2-client- , http2-client-grpc- , http2-grpc-proto3-wire- , mu-protobuf- , mu-rpc- , mu-schema- , sop-core- , stm- , stm-chans- , stm-conduit- , template-haskell >= 2.12- , text- , th-abstraction- hs-source-dirs: src- default-language: Haskell2010- ghc-options: -Wall- -fprint-potential-instances+ exposed-modules:+ Mu.GRpc.Client.Examples+ Mu.GRpc.Client.Optics+ Mu.GRpc.Client.Record+ Mu.GRpc.Client.TyApps++ other-modules: Mu.GRpc.Client.Internal+ build-depends:+ async+ , base >=4.12 && <5+ , bytestring+ , conduit+ , http2+ , http2-client+ , http2-client-grpc+ , http2-grpc-types+ , mu-grpc-common >=0.2.0+ , mu-optics >=0.2.0+ , mu-protobuf >=0.2.0+ , mu-rpc >=0.2.0+ , mu-schema >=0.2.0+ , optics-core+ , sop-core+ , stm+ , stm-chans+ , stm-conduit+ , template-haskell >=2.12+ , text+ , th-abstraction++ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall -fprint-potential-instances
src/Mu/GRpc/Client/Examples.hs view
@@ -32,7 +32,7 @@ fmap (\(HelloResponse r) -> r) <$> sayHello c (HelloRequest (Just req)) sayHello :: GrpcClient -> M HelloRequest -> IO (GRpcReply (M HelloResponse))-sayHello = gRpcCall @QuickStartService @"SayHello"+sayHello = gRpcCall @'MsgProtoBuf @QuickStartService @"SayHello" sayHi' :: HostName -> PortNumber -> Int -> IO [GRpcReply (Maybe T.Text)] sayHi' host port n@@ -41,4 +41,4 @@ runConduit $ cndt .| C.map (fmap (\(HelloResponse r) -> r)) .| consume sayHi :: GrpcClient -> M HiRequest -> IO (ConduitT () (GRpcReply (M HelloResponse)) IO ())-sayHi = gRpcCall @QuickStartService @"SayHi"+sayHi = gRpcCall @'MsgProtoBuf @QuickStartService @"SayHi"
src/Mu/GRpc/Client/Internal.hs view
@@ -8,6 +8,7 @@ {-# language PolyKinds #-} {-# language ScopedTypeVariables #-} {-# language TypeApplications #-}+{-# language TypeFamilies #-} {-# language TypeOperators #-} {-# language UndecidableInstances #-} -- | Client for gRPC services defined using Mu 'Service'@@ -18,33 +19,39 @@ import Control.Concurrent.STM.TMChan import Control.Concurrent.STM.TMVar import Control.Monad.IO.Class-import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import Data.Conduit import qualified Data.Conduit.Combinators as C import Data.Conduit.TMChan+import Data.Kind import Network.GRPC.Client (CompressMode (..), IncomingEvent (..), OutgoingEvent (..), RawReply, StreamDone (..)) import Network.GRPC.Client.Helpers-import Network.GRPC.HTTP2.Proto3Wire+import Network.GRPC.HTTP2.Encoding (GRPCInput, GRPCOutput) import Network.HTTP2 (ErrorCode) import Network.HTTP2.Client (ClientError, ClientIO, TooMuchConcurrency, runExceptT) import Mu.Adapter.ProtoBuf.Via+import Mu.GRpc.Avro+import Mu.GRpc.Bridge import Mu.Rpc import Mu.Schema setupGrpcClient' :: GrpcClientConfig -> IO (Either ClientError GrpcClient) setupGrpcClient' = runExceptT . setupGrpcClient -class GRpcServiceMethodCall (s :: Service snm mnm) (m :: Method mnm) h where- gRpcServiceMethodCall :: Proxy s -> Proxy m -> GrpcClient -> h-instance (KnownName serviceName, KnownName (FindPackageName anns), GRpcMethodCall m h)- => GRpcServiceMethodCall ('Service serviceName anns methods) m h where- gRpcServiceMethodCall _ = gRpcMethodCall pkgName svrName+class GRpcServiceMethodCall (p :: GRpcMessageProtocol) (s :: Service snm mnm) (m :: Method mnm) h where+ gRpcServiceMethodCall :: Proxy p -> Proxy s -> Proxy m -> GrpcClient -> h+instance ( KnownName serviceName, KnownName (FindPackageName anns), KnownName mname+ , GRpcMethodCall p ('Method mname manns margs mret) h, MkRPC p )+ => GRpcServiceMethodCall p ('Service serviceName anns methods)+ ('Method mname manns margs mret) h where+ gRpcServiceMethodCall pro _ = gRpcMethodCall @p rpc where pkgName = BS.pack (nameVal (Proxy @(FindPackageName anns))) svrName = BS.pack (nameVal (Proxy @serviceName))+ metName = BS.pack (nameVal (Proxy @mname))+ rpc = mkRPC pro pkgName svrName metName data GRpcReply a = GRpcTooMuchConcurrency TooMuchConcurrency@@ -77,33 +84,70 @@ Left e -> return $ GRpcClientError e Right v -> return v -class GRpcMethodCall method h where- gRpcMethodCall :: ByteString -> ByteString -> Proxy method -> GrpcClient -> h+-- These type classes allow us to abstract over+-- the choice of message protocol (PB or Avro) -instance (KnownName name, handler ~ IO (GRpcReply ()))- => GRpcMethodCall ('Method name anns '[ ] 'RetNothing) handler where- gRpcMethodCall pkgName srvName _ client+class GRPCInput (RPCTy p) (GRpcIWTy p ref r)+ => GRpcInputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef) (r :: Type) where+ type GRpcIWTy p ref r :: Type+ buildGRpcIWTy :: Proxy p -> Proxy ref -> r -> GRpcIWTy p ref r++instance ToProtoBufTypeRef ref r+ => GRpcInputWrapper 'MsgProtoBuf ref r where+ type GRpcIWTy 'MsgProtoBuf ref r = ViaToProtoBufTypeRef ref r+ buildGRpcIWTy _ _ = ViaToProtoBufTypeRef++instance (GRPCInput AvroRPC (ViaToAvroTypeRef ('ViaSchema sch sty) r))+ => GRpcInputWrapper 'MsgAvro ('ViaSchema sch sty) r where+ type GRpcIWTy 'MsgAvro ('ViaSchema sch sty) r = ViaToAvroTypeRef ('ViaSchema sch sty) r+ buildGRpcIWTy _ _ = ViaToAvroTypeRef++class GRPCOutput (RPCTy p) (GRpcOWTy p ref r)+ => GRpcOutputWrapper (p :: GRpcMessageProtocol) (ref :: TypeRef) (r :: Type) where+ type GRpcOWTy p ref r :: Type+ unGRpcOWTy :: Proxy p -> Proxy ref -> GRpcOWTy p ref r -> r++instance FromProtoBufTypeRef ref r+ => GRpcOutputWrapper 'MsgProtoBuf ref r where+ type GRpcOWTy 'MsgProtoBuf ref r = ViaFromProtoBufTypeRef ref r+ unGRpcOWTy _ _ = unViaFromProtoBufTypeRef++instance (GRPCOutput AvroRPC (ViaFromAvroTypeRef ('ViaSchema sch sty) r))+ => GRpcOutputWrapper 'MsgAvro ('ViaSchema sch sty) r where+ type GRpcOWTy 'MsgAvro ('ViaSchema sch sty) r = ViaFromAvroTypeRef ('ViaSchema sch sty) r+ unGRpcOWTy _ _ = unViaFromAvroTypeRef++-- -----------------------------+-- IMPLEMENTATION OF THE METHODS+-- -----------------------------++class GRpcMethodCall (p :: GRpcMessageProtocol) method h where+ gRpcMethodCall :: RPCTy p -> Proxy method -> GrpcClient -> h++instance ( KnownName name+ , GRPCInput (RPCTy p) (), GRPCOutput (RPCTy p) ()+ , handler ~ IO (GRpcReply ()) )+ => GRpcMethodCall p ('Method name anns '[ ] 'RetNothing) handler where+ gRpcMethodCall rpc _ client = simplifyResponse $ buildGRpcReply1 <$> rawUnary rpc client ()- where methodName = BS.pack (nameVal (Proxy @name))- rpc = RPC pkgName srvName methodName -instance ( KnownName name, FromProtoBufTypeRef rref r+instance ( KnownName name+ , GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r , handler ~ IO (GRpcReply r) )- => GRpcMethodCall ('Method name anns '[ ] ('RetSingle rref)) handler where- gRpcMethodCall pkgName srvName _ client- = fmap (fmap unViaFromProtoBufTypeRef) $+ => GRpcMethodCall p ('Method name anns '[ ] ('RetSingle rref)) handler where+ gRpcMethodCall rpc _ client+ = fmap (fmap (unGRpcOWTy (Proxy @p) (Proxy @rref))) $ simplifyResponse $ buildGRpcReply1 <$>- rawUnary @_ @_ @(ViaFromProtoBufTypeRef rref _) rpc client ()- where methodName = BS.pack (nameVal (Proxy @name))- rpc = RPC pkgName srvName methodName+ rawUnary @_ @() @(GRpcOWTy p rref r) rpc client () -instance ( KnownName name, FromProtoBufTypeRef rref r- , handler ~ (IO (ConduitT () (GRpcReply r) IO ())) )- => GRpcMethodCall ('Method name anns '[ ] ('RetStream rref)) handler where- gRpcMethodCall pkgName srvName _ client+instance ( KnownName name+ , GRPCInput (RPCTy p) (), GRpcOutputWrapper p rref r+ , handler ~ IO (ConduitT () (GRpcReply r) IO ()) )+ => GRpcMethodCall p ('Method name anns '[ ] ('RetStream rref)) handler where+ gRpcMethodCall rpc _ client = do -- Create a new TMChan chan <- newTMChanIO :: IO (TMChan r) var <- newEmptyTMVarIO -- if full, this means an error@@ -111,11 +155,12 @@ _ <- async $ do v <- simplifyResponse $ buildGRpcReply3 <$>- rawStreamServer @_ @() @(ViaFromProtoBufTypeRef rref r)+ rawStreamServer @_ @() @(GRpcOWTy p rref r) rpc client () ()- (\_ _ (ViaFromProtoBufTypeRef newVal) -> liftIO $ atomically $+ (\_ _ newVal -> liftIO $ atomically $ do -- on the first iteration, say that everything is OK- tryPutTMVar var (GRpcOk ()) >> writeTMChan chan newVal)+ _ <- tryPutTMVar var (GRpcOk ())+ writeTMChan chan (unGRpcOWTy (Proxy @p) (Proxy @rref) newVal)) case v of GRpcOk () -> liftIO $ atomically $ closeTMChan chan _ -> liftIO $ atomically $ putTMVar var v@@ -126,47 +171,44 @@ sourceTMChan chan .| C.map GRpcOk e -> yield $ (\_ -> error "this should never happen") <$> e return go- where methodName = BS.pack (nameVal (Proxy @name))- rpc = RPC pkgName srvName methodName -instance ( KnownName name, ToProtoBufTypeRef vref v+instance ( KnownName name+ , GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) () , handler ~ (v -> IO (GRpcReply ())) )- => GRpcMethodCall ('Method name anns '[ 'ArgSingle vref ] 'RetNothing) handler where- gRpcMethodCall pkgName srvName _ client x+ => GRpcMethodCall p ('Method name anns '[ 'ArgSingle vref ] 'RetNothing) handler where+ gRpcMethodCall rpc _ client x = simplifyResponse $ buildGRpcReply1 <$>- rawUnary @_ @(ViaToProtoBufTypeRef vref _) rpc client (ViaToProtoBufTypeRef x)- where methodName = BS.pack (nameVal (Proxy @name))- rpc = RPC pkgName srvName methodName+ rawUnary @_ @(GRpcIWTy p vref v) @() rpc client (buildGRpcIWTy (Proxy @p) (Proxy @vref) x) -instance ( KnownName name, ToProtoBufTypeRef vref v, FromProtoBufTypeRef rref r+instance ( KnownName name+ , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r , handler ~ (v -> IO (GRpcReply r)) )- => GRpcMethodCall ('Method name anns '[ 'ArgSingle vref ] ('RetSingle rref)) handler where- gRpcMethodCall pkgName srvName _ client x- = fmap (fmap unViaFromProtoBufTypeRef) $+ => GRpcMethodCall p ('Method name anns '[ 'ArgSingle vref ] ('RetSingle rref)) handler where+ gRpcMethodCall rpc _ client x+ = fmap (fmap (unGRpcOWTy (Proxy @p) (Proxy @rref))) $ simplifyResponse $ buildGRpcReply1 <$>- rawUnary @_ @(ViaToProtoBufTypeRef vref _) @(ViaFromProtoBufTypeRef rref _)- rpc client (ViaToProtoBufTypeRef x)- where methodName = BS.pack (nameVal (Proxy @name))- rpc = RPC pkgName srvName methodName+ rawUnary @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r)+ rpc client (buildGRpcIWTy (Proxy @p) (Proxy @vref) x) -instance ( KnownName name, ToProtoBufTypeRef vref v, FromProtoBufTypeRef rref r+instance ( KnownName name+ , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r , handler ~ (CompressMode -> IO (ConduitT v Void IO (GRpcReply r))) )- => GRpcMethodCall ('Method name anns '[ 'ArgStream vref ] ('RetSingle rref)) handler where- gRpcMethodCall pkgName srvName _ client compress+ => GRpcMethodCall p ('Method name anns '[ 'ArgStream vref ] ('RetSingle rref)) handler where+ gRpcMethodCall rpc _ client compress = do -- Create a new TMChan chan <- newTMChanIO :: IO (TMChan v) -- Start executing the client in another thread promise <- async $- fmap (fmap unViaFromProtoBufTypeRef) $+ fmap (fmap (unGRpcOWTy (Proxy @p) (Proxy @rref))) $ simplifyResponse $ buildGRpcReply2 <$>- rawStreamClient @_ @(ViaToProtoBufTypeRef vref v) @(ViaFromProtoBufTypeRef rref r) rpc client ()+ rawStreamClient @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) rpc client () (\_ -> do nextVal <- liftIO $ atomically $ readTMChan chan case nextVal of Nothing -> return ((), Left StreamDone)- Just v -> return ((), Right (compress, ViaToProtoBufTypeRef v)))+ Just v -> return ((), Right (compress, buildGRpcIWTy (Proxy @p) (Proxy @vref) v))) -- This conduit feeds information to the other thread let go = do x <- await case x of@@ -175,13 +217,12 @@ Nothing -> do liftIO $ atomically $ closeTMChan chan liftIO $ wait promise return go- where methodName = BS.pack (nameVal (Proxy @name))- rpc = RPC pkgName srvName methodName -instance ( KnownName name, ToProtoBufTypeRef vref v, FromProtoBufTypeRef rref r+instance ( KnownName name+ , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r , handler ~ (v -> IO (ConduitT () (GRpcReply r) IO ())) )- => GRpcMethodCall ('Method name anns '[ 'ArgSingle vref ] ('RetStream rref)) handler where- gRpcMethodCall pkgName srvName _ client x+ => GRpcMethodCall p ('Method name anns '[ 'ArgSingle vref ] ('RetStream rref)) handler where+ gRpcMethodCall rpc _ client x = do -- Create a new TMChan chan <- newTMChanIO :: IO (TMChan r) var <- newEmptyTMVarIO -- if full, this means an error@@ -189,11 +230,12 @@ _ <- async $ do v <- simplifyResponse $ buildGRpcReply3 <$>- rawStreamServer @_ @(ViaToProtoBufTypeRef vref v) @(ViaFromProtoBufTypeRef rref r)- rpc client () (ViaToProtoBufTypeRef x)- (\_ _ (ViaFromProtoBufTypeRef newVal) -> liftIO $ atomically $+ rawStreamServer @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r)+ rpc client () (buildGRpcIWTy (Proxy @p) (Proxy @vref) x)+ (\_ _ newVal -> liftIO $ atomically $ do -- on the first iteration, say that everything is OK- tryPutTMVar var (GRpcOk ()) >> writeTMChan chan newVal)+ _ <- tryPutTMVar var (GRpcOk ())+ writeTMChan chan (unGRpcOWTy (Proxy @p) (Proxy @rref) newVal)) case v of GRpcOk () -> liftIO $ atomically $ closeTMChan chan _ -> liftIO $ atomically $ putTMVar var v@@ -204,13 +246,12 @@ sourceTMChan chan .| C.map GRpcOk e -> yield $ (\_ -> error "this should never happen") <$> e return go- where methodName = BS.pack (nameVal (Proxy @name))- rpc = RPC pkgName srvName methodName -instance ( KnownName name, ToProtoBufTypeRef vref v, FromProtoBufTypeRef rref r+instance ( KnownName name+ , GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r , handler ~ (CompressMode -> IO (ConduitT v (GRpcReply r) IO ())) )- => GRpcMethodCall ('Method name anns '[ 'ArgStream vref ] ('RetStream rref)) handler where- gRpcMethodCall pkgName srvName _ client compress+ => GRpcMethodCall p ('Method name anns '[ 'ArgStream vref ] ('RetStream rref)) handler where+ gRpcMethodCall rpc _ client compress = do -- Create a new TMChan inchan <- newTMChanIO :: IO (TMChan (GRpcReply r)) outchan <- newTMChanIO :: IO (TMChan v)@@ -220,19 +261,19 @@ v <- simplifyResponse $ buildGRpcReply3 <$> rawGeneralStream- @_ @(ViaToProtoBufTypeRef vref v) @(ViaFromProtoBufTypeRef rref r)+ @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r) rpc client () (\_ ievent -> do -- on the first iteration, say that everything is OK _ <- liftIO $ atomically $ tryPutTMVar var (GRpcOk ()) case ievent of- RecvMessage o -> liftIO $ atomically $ writeTMChan inchan (GRpcOk $ unViaFromProtoBufTypeRef o)+ RecvMessage o -> liftIO $ atomically $ writeTMChan inchan (GRpcOk $ unGRpcOWTy(Proxy @p) (Proxy @rref) o) Invalid e -> liftIO $ atomically $ writeTMChan inchan (GRpcErrorString (show e)) _ -> return () ) () (\_ -> do nextVal <- liftIO $ atomically $ readTMChan outchan case nextVal of Nothing -> return ((), Finalize)- Just v -> return ((), SendMessage compress (ViaToProtoBufTypeRef v)))+ Just v -> return ((), SendMessage compress (buildGRpcIWTy (Proxy @p) (Proxy @vref) v))) case v of GRpcOk () -> liftIO $ atomically $ closeTMChan inchan _ -> liftIO $ atomically $ putTMVar var v@@ -251,5 +292,3 @@ Just Nothing -> go2 Just (Just nextIn) -> yield nextIn >> go2 return go- where methodName = BS.pack (nameVal (Proxy @name))- rpc = RPC pkgName srvName methodName
+ src/Mu/GRpc/Client/Optics.hs view
@@ -0,0 +1,161 @@+{-# language AllowAmbiguousTypes #-}+{-# language DataKinds #-}+{-# language FlexibleInstances #-}+{-# language FunctionalDependencies #-}+{-# language GADTs #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language TypeFamilies #-}+{-# language TypeOperators #-}+{-# language UndecidableInstances #-}+{-|+Description : Client for gRPC services using optics and labels++For further information over initialization of the connection,+consult the <http://hackage.haskell.org/package/http2-client-grpc http2-client-grpc docs>.+-}+module Mu.GRpc.Client.Optics (+ -- * Initialization of the gRPC client+ GRpcConnection+, initGRpc+, GRpcMessageProtocol(..)+, msgProtoBuf+, msgAvro+, G.GrpcClientConfig+, G.grpcClientConfigSimple+ -- * Request arguments and responses+, CompressMode+, GRpcReply(..)+ -- * Re-exported for convenience+, module Optics.Core+, module Mu.Schema.Optics+) where++import qualified Data.ByteString.Char8 as BS+import Data.Conduit+import Data.Functor.Identity+import Data.Proxy+import GHC.TypeLits+import Network.GRPC.Client (CompressMode)+import qualified Network.GRPC.Client.Helpers as G+import Network.HTTP2.Client (ClientError)+import Optics.Core++import Mu.GRpc.Bridge+import Mu.GRpc.Client.Internal+import Mu.Rpc+import Mu.Schema+import Mu.Schema.Optics++-- | Represents a connection to the service @s@.+newtype GRpcConnection (s :: Service Symbol Symbol) (p :: GRpcMessageProtocol)+ = GRpcConnection { gcClient :: G.GrpcClient }++-- | Initializes a connection to a gRPC server.+-- Usually the service you are connecting to is+-- inferred from the usage later on.+-- However, it can also be made explicit by using+--+-- > initGRpc config @Service+--+initGRpc :: G.GrpcClientConfig -- ^ gRPC configuration+ -> Proxy p+ -> forall s. IO (Either ClientError (GRpcConnection s p))+initGRpc config _ = do+ setup <- setupGrpcClient' config+ case setup of+ Left e -> return $ Left e+ Right c -> return $ Right $ GRpcConnection c++instance forall (serviceName :: Symbol) anns (methods :: [Method Symbol]) (m :: Symbol)+ (t :: *) (p :: GRpcMessageProtocol).+ ( SearchMethodOptic p methods m t+ , KnownName serviceName+ , KnownName (FindPackageName anns)+ , KnownName m+ , MkRPC p )+ => LabelOptic m A_Getter+ (GRpcConnection ('Service serviceName anns methods) p)+ (GRpcConnection ('Service serviceName anns methods) p)+ t t where+ labelOptic = to (searchMethodOptic @p (Proxy @methods) (Proxy @m) rpc . gcClient)+ where pkgName = BS.pack (nameVal (Proxy @(FindPackageName anns)))+ svrName = BS.pack (nameVal (Proxy @serviceName))+ metName = BS.pack (nameVal (Proxy @m))+ rpc = mkRPC (Proxy @p) pkgName svrName metName++class SearchMethodOptic (p :: GRpcMessageProtocol) (methods :: [Method Symbol]) (m :: Symbol) t+ | p methods m -> t where+ searchMethodOptic :: Proxy methods -> Proxy m -> RPCTy p -> G.GrpcClient -> t++{- Not possible due to functional dependency+instance TypeError ('Text "could not find method " ':<>: ShowType m)+ => SearchMethodOptic '[] m t where+-}+instance {-# OVERLAPS #-} MethodOptic p ('Method name anns ins outs) t+ => SearchMethodOptic p ('Method name anns ins outs ': rest) name t where+ searchMethodOptic _ _ rpc = methodOptic @p rpc (Proxy @('Method name anns ins outs))+instance {-# OVERLAPPABLE #-} SearchMethodOptic p rest name t+ => SearchMethodOptic p ('Method other anns ins outs ': rest) name t where+ searchMethodOptic _ = searchMethodOptic @p (Proxy @rest)++class GRpcMethodCall p method t+ => MethodOptic (p :: GRpcMessageProtocol) (method :: Method Symbol) t+ | p method -> t where+ methodOptic :: RPCTy p -> Proxy method -> G.GrpcClient -> t+ methodOptic = gRpcMethodCall @p++class ProtocolWrapper (p :: GRpcMessageProtocol) (w :: * -> *) | p -> w where+instance ProtocolWrapper 'MsgAvro Identity where+instance ProtocolWrapper 'MsgProtoBuf Maybe where++-- No arguments+instance forall (name :: Symbol) anns t p.+ ( GRpcMethodCall p ('Method name anns '[ ] 'RetNothing) t+ , t ~ IO (GRpcReply ()) )+ => MethodOptic p ('Method name anns '[ ] 'RetNothing) t+instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (r :: Symbol) anns t p w.+ ( GRpcMethodCall p ('Method name anns '[ ] ('RetSingle ('ViaSchema sch r))) t+ , ProtocolWrapper p w+ , t ~ IO (GRpcReply (Term w sch (sch :/: r))) )+ => MethodOptic p ('Method name anns '[ ] ('RetSingle ('ViaSchema sch r))) t+instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (r :: Symbol) anns t p w.+ ( GRpcMethodCall p ('Method name anns '[ ] ('RetStream ('ViaSchema sch r))) t+ , ProtocolWrapper p w+ , t ~ IO (ConduitT () (GRpcReply (Term w sch (sch :/: r))) IO ()) )+ => MethodOptic p ('Method name anns '[ ] ('RetStream ('ViaSchema sch r))) t+-- Simple arguments+instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) anns t p w.+ ( GRpcMethodCall p ('Method name anns '[ 'ArgSingle ('ViaSchema sch v) ] 'RetNothing) t+ , ProtocolWrapper p w+ , t ~ (Term w sch (sch :/: v) -> IO (GRpcReply ())) )+ => MethodOptic p ('Method name anns '[ 'ArgSingle ('ViaSchema sch v) ] 'RetNothing) t+instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) anns t p w.+ ( GRpcMethodCall p ('Method name anns '[ 'ArgSingle ('ViaSchema sch v) ] ('RetSingle ('ViaSchema sch r))) t+ , ProtocolWrapper p w+ , t ~ (Term w sch (sch :/: v)+ -> IO (GRpcReply (Term w sch (sch :/: r))) ) )+ => MethodOptic p ('Method name anns '[ 'ArgSingle ('ViaSchema sch v) ] ('RetSingle ('ViaSchema sch r))) t+instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) anns t p w.+ ( GRpcMethodCall p ('Method name anns '[ 'ArgSingle ('ViaSchema sch v) ] ('RetStream ('ViaSchema sch r))) t+ , ProtocolWrapper p w+ , t ~ (Term w sch (sch :/: v)+ -> IO (ConduitT () (GRpcReply (Term Maybe sch (sch :/: r))) IO ()) ) )+ => MethodOptic p ('Method name anns '[ 'ArgSingle ('ViaSchema sch v) ] ('RetStream ('ViaSchema sch r))) t+-- Stream arguments+instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) anns t p w.+ ( GRpcMethodCall p ('Method name anns '[ 'ArgStream ('ViaSchema sch v) ] ('RetSingle ('ViaSchema sch r))) t+ , ProtocolWrapper p w+ , t ~ (CompressMode+ -> IO (ConduitT (Term w sch (sch :/: v))+ Void IO+ (GRpcReply (Term w sch (sch :/: r))))) )+ => MethodOptic p ('Method name anns '[ 'ArgStream ('ViaSchema sch v) ] ('RetSingle ('ViaSchema sch r))) t+instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) anns t p w.+ ( GRpcMethodCall p ('Method name anns '[ 'ArgStream ('ViaSchema sch v) ] ('RetStream ('ViaSchema sch r))) t+ , ProtocolWrapper p w+ , t ~ (CompressMode+ -> IO (ConduitT (Term w sch (sch :/: v))+ (GRpcReply (Term w sch (sch :/: r))) IO ())) )+ => MethodOptic p ('Method name anns '[ 'ArgStream ('ViaSchema sch v) ] ('RetStream ('ViaSchema sch r))) t
src/Mu/GRpc/Client/Record.hs view
@@ -24,6 +24,7 @@ , setupGrpcClient' -- * Fill and generate the Haskell record of functions , buildService+, GRpcMessageProtocol(..) , CompressMode(..) , GRpcReply(..) , generateRecordFromService@@ -42,39 +43,41 @@ import Network.GRPC.Client (CompressMode (..)) import Network.GRPC.Client.Helpers +import Mu.GRpc.Bridge import Mu.GRpc.Client.Internal import Mu.Rpc -- | Fills in a Haskell record of functions with the corresponding -- calls to gRPC services from a Mu 'Service' declaration.-buildService :: forall (s :: Service') (p :: Symbol) t+buildService :: forall (pro :: GRpcMessageProtocol) (s :: Service') (p :: Symbol) t (nm :: Symbol) (anns :: [ServiceAnnotation]) (ms :: [Method Symbol]).- (s ~ 'Service nm anns ms, Generic t, BuildService s p ms (Rep t))+ (s ~ 'Service nm anns ms, Generic t, BuildService pro s p ms (Rep t)) => GrpcClient -> t-buildService client = to (buildService' (Proxy @s) (Proxy @p) (Proxy @ms) client)+buildService client = to (buildService' (Proxy @pro) (Proxy @s) (Proxy @p) (Proxy @ms) client) -class BuildService (s :: Service') (p :: Symbol) (ms :: [Method Symbol]) (f :: * -> *) where- buildService' :: Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a+class BuildService (pro :: GRpcMessageProtocol) (s :: Service')+ (p :: Symbol) (ms :: [Method Symbol]) (f :: * -> *) where+ buildService' :: Proxy pro -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a -instance BuildService s p ms U1 where- buildService' _ _ _ _ = U1-instance BuildService s p ms f => BuildService s p ms (D1 meta f) where- buildService' ps ppr pms client- = M1 (buildService' ps ppr pms client)-instance BuildService s p ms f => BuildService s p ms (C1 meta f) where- buildService' ps ppr pms client- = M1 (buildService' ps ppr pms client)+instance BuildService pro s p ms U1 where+ buildService' _ _ _ _ _ = U1+instance BuildService pro s p ms f => BuildService pro s p ms (D1 meta f) where+ buildService' ppro ps ppr pms client+ = M1 (buildService' ppro ps ppr pms client)+instance BuildService pro s p ms f => BuildService pro s p ms (C1 meta f) where+ buildService' ppro ps ppr pms client+ = M1 (buildService' ppro ps ppr pms client) instance TypeError ('Text "building a service from sums is not supported")- => BuildService s p ms (f :+: g) where+ => BuildService pro s p ms (f :+: g) where buildService' = error "this should never happen"-instance (BuildService s p ms f, BuildService s p ms g)- => BuildService s p ms (f :*: g) where- buildService' ps ppr pms client- = buildService' ps ppr pms client :*: buildService' ps ppr pms client-instance (m ~ AppendSymbol p x, GRpcServiceMethodCall s (s :-->: x) h)- => BuildService s p ms (S1 ('MetaSel ('Just m) u ss ds) (K1 i h)) where- buildService' ps _ _ client- = M1 $ K1 $ gRpcServiceMethodCall ps (Proxy @(s :-->: x)) client+instance (BuildService pro s p ms f, BuildService pro s p ms g)+ => BuildService pro s p ms (f :*: g) where+ buildService' ppro ps ppr pms client+ = buildService' ppro ps ppr pms client :*: buildService' ppro ps ppr pms client+instance (m ~ AppendSymbol p x, GRpcServiceMethodCall pro s (s :-->: x) h)+ => BuildService pro s p ms (S1 ('MetaSel ('Just m) u ss ds) (K1 i h)) where+ buildService' ppro ps _ _ client+ = M1 $ K1 $ gRpcServiceMethodCall ppro ps (Proxy @(s :-->: x)) client -- TEMPLATE HASKELL -- ================
src/Mu/GRpc/Client/TyApps.hs view
@@ -21,6 +21,7 @@ , setupGrpcClient' -- * Call methods from the gRPC service , gRpcCall+, GRpcMessageProtocol(..) , CompressMode(..) , GRpcReply(..) ) where@@ -31,19 +32,20 @@ import Mu.Rpc import Mu.Schema +import Mu.GRpc.Bridge import Mu.GRpc.Client.Internal -- | Call a method from a Mu definition. -- This method is thought to be used with @TypeApplications@: ----- > gRpcCall @"packageName" @ServiceDeclaration @"method"+-- > gRpcCall @'MsgFormat @"packageName" @ServiceDeclaration @"method" -- -- The additional arguments you must provide to 'gRpcCall' -- depend on the signature of the method itself: -- * The resulting value is always wrapped in 'GRpcReply'. -- * A single input or output turns into a single value. -- * A streaming input or output turns into a Conduit.-gRpcCall :: forall s methodName h.- (GRpcServiceMethodCall s (s :-->: methodName) h)+gRpcCall :: forall (pro :: GRpcMessageProtocol) s methodName h.+ (GRpcServiceMethodCall pro s (s :-->: methodName) h) => GrpcClient -> h-gRpcCall = gRpcServiceMethodCall (Proxy @s) (Proxy @(s :-->: methodName))+gRpcCall = gRpcServiceMethodCall (Proxy @pro) (Proxy @s) (Proxy @(s :-->: methodName))