{-# language AllowAmbiguousTypes #-}
{-# language DataKinds #-}
{-# language FlexibleInstances #-}
{-# language FunctionalDependencies #-}
{-# language GADTs #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
module Mu.GRpc.Client.Optics (
GRpcConnection
, initGRpc
, GRpcMessageProtocol(..)
, msgProtoBuf
, msgAvro
, G.GrpcClientConfig
, G.grpcClientConfigSimple
, CompressMode
, GRpcReply(..)
, 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
newtype GRpcConnection (s :: Service Symbol Symbol) (p :: GRpcMessageProtocol)
= GRpcConnection { GRpcConnection s p -> GrpcClient
gcClient :: G.GrpcClient }
initGRpc :: G.GrpcClientConfig
-> Proxy p
-> forall s. IO (Either ClientError (GRpcConnection s p))
initGRpc :: GrpcClientConfig
-> Proxy p
-> forall (s :: Service Symbol Symbol).
IO (Either ClientError (GRpcConnection s p))
initGRpc config :: GrpcClientConfig
config _ = do
Either ClientError GrpcClient
setup <- GrpcClientConfig -> IO (Either ClientError GrpcClient)
setupGrpcClient' GrpcClientConfig
config
case Either ClientError GrpcClient
setup of
Left e :: ClientError
e -> Either ClientError (GRpcConnection s p)
-> IO (Either ClientError (GRpcConnection s p))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ClientError (GRpcConnection s p)
-> IO (Either ClientError (GRpcConnection s p)))
-> Either ClientError (GRpcConnection s p)
-> IO (Either ClientError (GRpcConnection s p))
forall a b. (a -> b) -> a -> b
$ ClientError -> Either ClientError (GRpcConnection s p)
forall a b. a -> Either a b
Left ClientError
e
Right c :: GrpcClient
c -> Either ClientError (GRpcConnection s p)
-> IO (Either ClientError (GRpcConnection s p))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ClientError (GRpcConnection s p)
-> IO (Either ClientError (GRpcConnection s p)))
-> Either ClientError (GRpcConnection s p)
-> IO (Either ClientError (GRpcConnection s p))
forall a b. (a -> b) -> a -> b
$ GRpcConnection s p -> Either ClientError (GRpcConnection s p)
forall a b. b -> Either a b
Right (GRpcConnection s p -> Either ClientError (GRpcConnection s p))
-> GRpcConnection s p -> Either ClientError (GRpcConnection s p)
forall a b. (a -> b) -> a -> b
$ GrpcClient -> GRpcConnection s p
forall (s :: Service Symbol Symbol) (p :: GRpcMessageProtocol).
GrpcClient -> GRpcConnection s p
GRpcConnection GrpcClient
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 :: Optic
A_Getter
NoIx
(GRpcConnection ('Service serviceName anns methods) p)
(GRpcConnection ('Service serviceName anns methods) p)
t
t
labelOptic = (GRpcConnection ('Service serviceName anns methods) p -> t)
-> Optic
A_Getter
NoIx
(GRpcConnection ('Service serviceName anns methods) p)
(GRpcConnection ('Service serviceName anns methods) p)
t
t
forall s a. (s -> a) -> Getter s a
to (Proxy methods -> Proxy m -> RPCTy p -> GrpcClient -> t
forall (p :: GRpcMessageProtocol) (methods :: [Method Symbol])
(m :: Symbol) t.
SearchMethodOptic p methods m t =>
Proxy methods -> Proxy m -> RPCTy p -> GrpcClient -> t
searchMethodOptic @p (Proxy methods
forall k (t :: k). Proxy t
Proxy @methods) (Proxy m
forall k (t :: k). Proxy t
Proxy @m) RPCTy p
rpc (GrpcClient -> t)
-> (GRpcConnection ('Service serviceName anns methods) p
-> GrpcClient)
-> GRpcConnection ('Service serviceName anns methods) p
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRpcConnection ('Service serviceName anns methods) p -> GrpcClient
forall (s :: Service Symbol Symbol) (p :: GRpcMessageProtocol).
GRpcConnection s p -> GrpcClient
gcClient)
where pkgName :: ByteString
pkgName = String -> ByteString
BS.pack (Proxy (FindPackageName anns) -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy (FindPackageName anns)
forall k (t :: k). Proxy t
Proxy @(FindPackageName anns)))
svrName :: ByteString
svrName = String -> ByteString
BS.pack (Proxy serviceName -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy serviceName
forall k (t :: k). Proxy t
Proxy @serviceName))
metName :: ByteString
metName = String -> ByteString
BS.pack (Proxy m -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy m
forall k (t :: k). Proxy t
Proxy @m))
rpc :: RPCTy p
rpc = Proxy p -> ByteString -> ByteString -> ByteString -> RPCTy p
forall (p :: GRpcMessageProtocol).
MkRPC p =>
Proxy p -> ByteString -> ByteString -> ByteString -> RPCTy p
mkRPC (Proxy p
forall k (t :: k). Proxy t
Proxy @p) ByteString
pkgName ByteString
svrName ByteString
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
instance {-# OVERLAPS #-} MethodOptic p ('Method name anns ins outs) t
=> SearchMethodOptic p ('Method name anns ins outs ': rest) name t where
searchMethodOptic :: Proxy ('Method name anns ins outs : rest)
-> Proxy name -> RPCTy p -> GrpcClient -> t
searchMethodOptic _ _ rpc :: RPCTy p
rpc = RPCTy p -> Proxy ('Method name anns ins outs) -> GrpcClient -> t
forall (p :: GRpcMessageProtocol) (method :: Method Symbol) t.
MethodOptic p method t =>
RPCTy p -> Proxy method -> GrpcClient -> t
methodOptic @p RPCTy p
rpc (Proxy ('Method name anns ins outs)
forall k (t :: k). Proxy t
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 :: Proxy ('Method other anns ins outs : rest)
-> Proxy name -> RPCTy p -> GrpcClient -> t
searchMethodOptic _ = Proxy rest -> Proxy name -> RPCTy p -> GrpcClient -> t
forall (p :: GRpcMessageProtocol) (methods :: [Method Symbol])
(m :: Symbol) t.
SearchMethodOptic p methods m t =>
Proxy methods -> Proxy m -> RPCTy p -> GrpcClient -> t
searchMethodOptic @p (Proxy rest
forall k (t :: k). Proxy t
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 = forall k (p :: GRpcMessageProtocol) (method :: k) h.
GRpcMethodCall p method h =>
RPCTy p -> Proxy method -> GrpcClient -> h
forall (method :: Method Symbol) h.
GRpcMethodCall p method h =>
RPCTy p -> Proxy method -> GrpcClient -> h
gRpcMethodCall @p
class ProtocolWrapper (p :: GRpcMessageProtocol) (w :: * -> *) | p -> w where
instance ProtocolWrapper 'MsgAvro Identity where
instance ProtocolWrapper 'MsgProtoBuf Maybe where
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
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
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