{-# 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
, initGRpcZipkin
, 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           Control.Monad.IO.Class
import qualified Data.ByteString.Char8       as BS
import           Data.Conduit
import           Data.Proxy
import           Data.Text                   as T
import           GHC.TypeLits
import           Monitor.Tracing
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 :: Package') (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 msgProtoBuf @Service
--
initGRpc :: MonadIO m
         => G.GrpcClientConfig  -- ^ gRPC configuration
         -> Proxy p
         -> forall s. m (Either ClientError (GRpcConnection s p))
initGRpc :: GrpcClientConfig
-> Proxy p
-> forall (s :: Package').
   m (Either ClientError (GRpcConnection s p))
initGRpc GrpcClientConfig
config Proxy p
_ = do
  Either ClientError GrpcClient
setup <- GrpcClientConfig -> m (Either ClientError GrpcClient)
forall (m :: * -> *).
MonadIO m =>
GrpcClientConfig -> m (Either ClientError GrpcClient)
setupGrpcClient' GrpcClientConfig
config
  Either ClientError (GRpcConnection s p)
-> m (Either ClientError (GRpcConnection s p))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ClientError (GRpcConnection s p)
 -> m (Either ClientError (GRpcConnection s p)))
-> Either ClientError (GRpcConnection s p)
-> m (Either ClientError (GRpcConnection s p))
forall a b. (a -> b) -> a -> b
$ case Either ClientError GrpcClient
setup of
    Left ClientError
e  -> ClientError -> Either ClientError (GRpcConnection s p)
forall a b. a -> Either a b
Left ClientError
e
    Right GrpcClient
c -> 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 :: Package') (p :: GRpcMessageProtocol).
GrpcClient -> GRpcConnection s p
GRpcConnection GrpcClient
c

-- | Initializes a connection to a gRPC server,
--   creating a new span for distributed tracing.
--   Usually the service you are connecting to is
--   inferred from the usage later on.
--   However, it can also be made explicit by using
--
--   > initGRpcZipkin config msgProtoBuf "person" @Service
--
initGRpcZipkin :: (MonadIO m, MonadTrace m)
               => G.GrpcClientConfig  -- ^ gRPC configuration
               -> Proxy p
               -> T.Text
               -> forall s. m (Either ClientError (GRpcConnection s p))
initGRpcZipkin :: GrpcClientConfig
-> Proxy p
-> Text
-> forall (s :: Package').
   m (Either ClientError (GRpcConnection s p))
initGRpcZipkin GrpcClientConfig
config Proxy p
_ Text
spanName = do
  Either ClientError GrpcClient
setup <- GrpcClientConfig -> Text -> m (Either ClientError GrpcClient)
forall (m :: * -> *).
(MonadIO m, MonadTrace m) =>
GrpcClientConfig -> Text -> m (Either ClientError GrpcClient)
setupGrpcClientZipkin GrpcClientConfig
config Text
spanName
  Either ClientError (GRpcConnection s p)
-> m (Either ClientError (GRpcConnection s p))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ClientError (GRpcConnection s p)
 -> m (Either ClientError (GRpcConnection s p)))
-> Either ClientError (GRpcConnection s p)
-> m (Either ClientError (GRpcConnection s p))
forall a b. (a -> b) -> a -> b
$ case Either ClientError GrpcClient
setup of
    Left ClientError
e  -> ClientError -> Either ClientError (GRpcConnection s p)
forall a b. a -> Either a b
Left ClientError
e
    Right GrpcClient
c -> 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 :: Package') (p :: GRpcMessageProtocol).
GrpcClient -> GRpcConnection s p
GRpcConnection GrpcClient
c

instance forall (pkg :: Package') (pkgName :: Symbol)
                (service :: Service') (serviceName :: Symbol)
                (methods :: [Method'])
                (p :: GRpcMessageProtocol) (m :: Symbol) t.
         ( pkg ~ 'Package ('Just pkgName) '[service]
         , service ~ 'Service serviceName methods
         , SearchMethodOptic p methods m t
         , KnownName serviceName
         , KnownName pkgName
         , KnownName m
         , MkRPC p )
         => LabelOptic m A_Getter
                       (GRpcConnection pkg p)
                       (GRpcConnection pkg p)
                       t t where
  labelOptic :: Optic
  A_Getter NoIx (GRpcConnection pkg p) (GRpcConnection pkg p) t t
labelOptic = (GRpcConnection pkg p -> t)
-> Optic
     A_Getter NoIx (GRpcConnection pkg p) (GRpcConnection pkg 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'])
       (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 pkg p -> GrpcClient)
-> GRpcConnection pkg p
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRpcConnection pkg p -> GrpcClient
forall (s :: Package') (p :: GRpcMessageProtocol).
GRpcConnection s p -> GrpcClient
gcClient)
    where pkgName :: ByteString
pkgName = String -> ByteString
BS.pack (Proxy pkgName -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy pkgName
forall k (t :: k). Proxy t
Proxy @pkgName))
          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']) (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 ins outs) t
         => SearchMethodOptic p ('Method name ins outs ': rest) name t where
  searchMethodOptic :: Proxy ('Method name ins outs : rest)
-> Proxy name -> RPCTy p -> GrpcClient -> t
searchMethodOptic Proxy ('Method name ins outs : rest)
_ Proxy name
_ RPCTy p
rpc = RPCTy p -> Proxy ('Method name ins outs) -> GrpcClient -> t
forall (p :: GRpcMessageProtocol) (method :: Method') t.
MethodOptic p method t =>
RPCTy p -> Proxy method -> GrpcClient -> t
methodOptic @p RPCTy p
rpc (Proxy ('Method name ins outs)
forall k (t :: k). Proxy t
Proxy @('Method name ins outs))
instance {-# OVERLAPPABLE #-} SearchMethodOptic p rest name t
         => SearchMethodOptic p ('Method other ins outs ': rest) name t where
  searchMethodOptic :: Proxy ('Method other ins outs : rest)
-> Proxy name -> RPCTy p -> GrpcClient -> t
searchMethodOptic Proxy ('Method other ins outs : rest)
_ = Proxy rest -> Proxy name -> RPCTy p -> GrpcClient -> t
forall (p :: GRpcMessageProtocol) (methods :: [Method'])
       (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') t
      | p method -> t where
  methodOptic :: RPCTy p -> Proxy method -> G.GrpcClient -> t
  methodOptic = forall (p :: GRpcMessageProtocol) (method :: Method') h.
GRpcMethodCall p method h =>
RPCTy p -> Proxy method -> GrpcClient -> h
forall (method :: Method') h.
GRpcMethodCall p method h =>
RPCTy p -> Proxy method -> GrpcClient -> h
gRpcMethodCall @p

-- No arguments
instance forall (name :: Symbol) t p.
         ( GRpcMethodCall p ('Method name '[ ] 'RetNothing) t
         , t ~ IO (GRpcReply ()) )
         => MethodOptic p ('Method name '[ ] 'RetNothing) t
instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (r :: Symbol) t p.
         ( GRpcMethodCall p ('Method name '[ ] ('RetSingle ('SchemaRef sch r))) t
         , t ~ IO (GRpcReply (Term sch (sch :/: r))) )
         => MethodOptic p ('Method name '[ ] ('RetSingle ('SchemaRef sch r))) t
instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (r :: Symbol) t p.
         ( GRpcMethodCall p ('Method name '[ ] ('RetStream ('SchemaRef sch r))) t
         , t ~ IO (ConduitT () (GRpcReply (Term sch (sch :/: r))) IO ()) )
         => MethodOptic p ('Method name '[ ] ('RetStream ('SchemaRef sch r))) t
-- Simple arguments
instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) aname t p.
         ( GRpcMethodCall p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] 'RetNothing) t
         , t ~ (Term sch (sch :/: v) -> IO (GRpcReply ())) )
         => MethodOptic p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] 'RetNothing) t
instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p.
         ( GRpcMethodCall p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t
         , t ~ (Term sch (sch :/: v)
               -> IO (GRpcReply (Term sch (sch :/: r))) ) )
         => MethodOptic p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v)  ] ('RetSingle ('SchemaRef sch r))) t
instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p.
         ( GRpcMethodCall p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v)  ] ('RetStream ('SchemaRef sch r))) t
         , t ~ (Term sch (sch :/: v)
                ->  IO (ConduitT () (GRpcReply (Term sch (sch :/: r))) IO ()) ) )
         => MethodOptic p ('Method name '[ 'ArgSingle aname ('SchemaRef sch v)  ] ('RetStream ('SchemaRef sch r))) t
-- Stream arguments
instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p.
         ( GRpcMethodCall p ('Method name '[ 'ArgStream aname ('SchemaRef sch v) ] ('RetSingle ('SchemaRef sch r))) t
         , t ~ (CompressMode
                -> IO (ConduitT (Term sch (sch :/: v))
                                Void IO
                                (GRpcReply (Term sch (sch :/: r))))) )
         => MethodOptic p ('Method name '[ 'ArgStream aname ('SchemaRef sch v)  ] ('RetSingle ('SchemaRef sch r))) t
instance forall (name :: Symbol) (sch :: Schema Symbol Symbol) (v :: Symbol) (r :: Symbol) aname t p.
         ( GRpcMethodCall p ('Method name '[ 'ArgStream aname ('SchemaRef sch v)  ] ('RetStream ('SchemaRef sch r))) t
         , t ~ (CompressMode
               -> IO (ConduitT (Term sch (sch :/: v))
                               (GRpcReply (Term sch (sch :/: r))) IO ())) )
         => MethodOptic p ('Method name '[ 'ArgStream aname ('SchemaRef sch v)  ] ('RetStream ('SchemaRef sch r))) t