{-# 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 { GRpcConnection s p -> GrpcClient
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 :: 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

{- 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 :: 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

-- 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