{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Handler for the gRPC Server Reflection API
-- (<https://github.com/grpc/grpc/blob/master/doc/server-reflection.md>),
-- @grpc.reflection.v1@ and the older @grpc.reflection.v1alpha@. This lets
-- generic clients (e.g. @grpcurl@) discover and decode this server's proto
-- services without a local copy of the @.proto@ files.
module Cardano.Rpc.Server.Internal.Reflection
  ( serverReflectionInfoMethodV1
  , serverReflectionInfoMethodV1alpha
  , answerReflectionRequest
  , qualifiedServiceName
  )
where

import Cardano.Rpc.Proto.Api.Reflection.V1 qualified as V1
import Cardano.Rpc.Proto.Api.Reflection.V1alpha qualified as V1alpha
import Cardano.Rpc.Server.Internal.Error (throwGrpcErrorWithMessage)
import Cardano.Rpc.Server.Internal.Reflection.DescriptorTable

import RIO

import Data.ProtoLens (Message, decodeMessage, defMessage, encodeMessage)
import Data.ProtoLens.Service.Types (Service, ServiceName, ServicePackage)
import Data.Text qualified as Text
import GHC.TypeLits (symbolVal)
import Network.GRPC.Spec
  ( GrpcError (GrpcInternal, GrpcInvalidArgument, GrpcNotFound)
  , NextElem (NextElem, NoNextElem)
  , Proto (Proto)
  , fromGrpcError
  )

-- | Handle the @ServerReflectionInfo@ bidirectional stream for
-- @grpc.reflection.v1@: answer every request on the incoming stream in
-- turn, then forward the client's own terminal marker. A bidi handler that
-- returns without sending 'NoNextElem' itself has its stream cancelled
-- instead of closed with trailers, the same requirement as for
-- server-streaming handlers (both go through grapesy's identical
-- @sendOutput call . fromNextElem call@ path).
serverReflectionInfoMethodV1
  :: MonadIO m
  => [Text]
  -- ^ Fully qualified names of every service registered with this server,
  -- answered verbatim for @list_services@
  -> IO (NextElem (Proto V1.ServerReflectionRequest))
  -> (NextElem (Proto V1.ServerReflectionResponse) -> IO ())
  -> m ()
serverReflectionInfoMethodV1 :: forall (m :: * -> *).
MonadIO m =>
[Text]
-> IO (NextElem (Proto ServerReflectionRequest))
-> (NextElem (Proto ServerReflectionResponse) -> IO ())
-> m ()
serverReflectionInfoMethodV1 [Text]
serviceNames IO (NextElem (Proto ServerReflectionRequest))
recv NextElem (Proto ServerReflectionResponse) -> IO ()
send = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
loop
 where
  loop :: IO ()
loop =
    IO (NextElem (Proto ServerReflectionRequest))
recv IO (NextElem (Proto ServerReflectionRequest))
-> (NextElem (Proto ServerReflectionRequest) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      NextElem (Proto ServerReflectionRequest)
NoNextElem -> NextElem (Proto ServerReflectionResponse) -> IO ()
send NextElem (Proto ServerReflectionResponse)
forall a. NextElem a
NoNextElem
      NextElem Proto ServerReflectionRequest
request -> do
        NextElem (Proto ServerReflectionResponse) -> IO ()
send (NextElem (Proto ServerReflectionResponse) -> IO ())
-> (Proto ServerReflectionResponse
    -> NextElem (Proto ServerReflectionResponse))
-> Proto ServerReflectionResponse
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto ServerReflectionResponse
-> NextElem (Proto ServerReflectionResponse)
forall a. a -> NextElem a
NextElem (Proto ServerReflectionResponse -> IO ())
-> Proto ServerReflectionResponse -> IO ()
forall a b. (a -> b) -> a -> b
$ DescriptorTable
-> [Text]
-> Proto ServerReflectionRequest
-> Proto ServerReflectionResponse
answerReflectionRequest DescriptorTable
descriptorTable [Text]
serviceNames Proto ServerReflectionRequest
request
        IO ()
loop

-- | Handle the same stream for the legacy @grpc.reflection.v1alpha@, by
-- bridging each message to and from @v1@ and answering with the one core
-- 'answerReflectionRequest'.
serverReflectionInfoMethodV1alpha
  :: MonadIO m
  => [Text]
  -- ^ Fully qualified names of every service registered with this server,
  -- answered verbatim for @list_services@
  -> IO (NextElem (Proto V1alpha.ServerReflectionRequest))
  -> (NextElem (Proto V1alpha.ServerReflectionResponse) -> IO ())
  -> m ()
serverReflectionInfoMethodV1alpha :: forall (m :: * -> *).
MonadIO m =>
[Text]
-> IO (NextElem (Proto ServerReflectionRequest))
-> (NextElem (Proto ServerReflectionResponse) -> IO ())
-> m ()
serverReflectionInfoMethodV1alpha [Text]
serviceNames IO (NextElem (Proto ServerReflectionRequest))
recv NextElem (Proto ServerReflectionResponse) -> IO ()
send = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
loop
 where
  loop :: IO ()
loop =
    IO (NextElem (Proto ServerReflectionRequest))
recv IO (NextElem (Proto ServerReflectionRequest))
-> (NextElem (Proto ServerReflectionRequest) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      NextElem (Proto ServerReflectionRequest)
NoNextElem -> NextElem (Proto ServerReflectionResponse) -> IO ()
send NextElem (Proto ServerReflectionResponse)
forall a. NextElem a
NoNextElem
      NextElem Proto ServerReflectionRequest
request -> do
        v1Request <- Proto ServerReflectionRequest -> IO (Proto ServerReflectionRequest)
forall a b (m :: * -> *).
(Message a, Message b, MonadIO m) =>
Proto a -> m (Proto b)
bridgeMessage Proto ServerReflectionRequest
request
        v1alphaResponse <- bridgeMessage (answerReflectionRequest descriptorTable serviceNames v1Request)
        send $ NextElem v1alphaResponse
        loop

-- | Answer one @ServerReflectionRequest@, dispatching on its
-- @message_request@ oneof.
--
-- Lookup failures ('V1.FileByFilename', 'V1.FileContainingSymbol') are
-- reported in-stream as an @ErrorResponse@ with @NOT_FOUND@, never as a
-- gRPC error: the RPC itself stays OK for the life of the stream.
-- No proto file served here declares proto2 extensions, so
-- @file_containing_extension@ always answers @NOT_FOUND@, while
-- @all_extension_numbers_of_type@ answers an empty @ExtensionNumberResponse@
-- for a type the server knows and @NOT_FOUND@ for one it does not.
answerReflectionRequest
  :: DescriptorTable
  -> [Text]
  -> Proto V1.ServerReflectionRequest
  -> Proto V1.ServerReflectionResponse
answerReflectionRequest :: DescriptorTable
-> [Text]
-> Proto ServerReflectionRequest
-> Proto ServerReflectionResponse
answerReflectionRequest DescriptorTable
table [Text]
serviceNames Proto ServerReflectionRequest
request =
  Proto ServerReflectionResponse
forall msg. Message msg => msg
defMessage
    Proto ServerReflectionResponse
-> (Proto ServerReflectionResponse
    -> Proto ServerReflectionResponse)
-> Proto ServerReflectionResponse
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ServerReflectionResponse) Text
forall (f :: * -> *) s a.
(Functor f, HasField s "validHost" a) =>
LensLike' f s a
V1.validHost LensLike' Identity (Proto ServerReflectionResponse) Text
-> Text
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Proto ServerReflectionRequest
request Proto ServerReflectionRequest
-> Getting Text (Proto ServerReflectionRequest) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (Proto ServerReflectionRequest) Text
forall (f :: * -> *) s a.
(Functor f, HasField s "host" a) =>
LensLike' f s a
V1.host)
    Proto ServerReflectionResponse
-> (Proto ServerReflectionResponse
    -> Proto ServerReflectionResponse)
-> Proto ServerReflectionResponse
forall a b. a -> (a -> b) -> b
& LensLike'
  Identity
  (Proto ServerReflectionResponse)
  (Proto ServerReflectionRequest)
forall (f :: * -> *) s a.
(Functor f, HasField s "originalRequest" a) =>
LensLike' f s a
V1.originalRequest LensLike'
  Identity
  (Proto ServerReflectionResponse)
  (Proto ServerReflectionRequest)
-> Proto ServerReflectionRequest
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto ServerReflectionRequest
request
    Proto ServerReflectionResponse
-> (Proto ServerReflectionResponse
    -> Proto ServerReflectionResponse)
-> Proto ServerReflectionResponse
forall a b. a -> (a -> b) -> b
& Proto ServerReflectionResponse -> Proto ServerReflectionResponse
answer
 where
  answer :: Proto V1.ServerReflectionResponse -> Proto V1.ServerReflectionResponse
  answer :: Proto ServerReflectionResponse -> Proto ServerReflectionResponse
answer = case Proto ServerReflectionRequest
request Proto ServerReflectionRequest
-> Getting
     (Maybe (Proto ServerReflectionRequest'MessageRequest))
     (Proto ServerReflectionRequest)
     (Maybe (Proto ServerReflectionRequest'MessageRequest))
-> Maybe (Proto ServerReflectionRequest'MessageRequest)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto ServerReflectionRequest'MessageRequest))
  (Proto ServerReflectionRequest)
  (Maybe (Proto ServerReflectionRequest'MessageRequest))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'messageRequest" a) =>
LensLike' f s a
V1.maybe'messageRequest of
    -- proto3 leaves message_request entirely unset when malformed by the
    -- client; there is no lookup to fail here, so this is INVALID_ARGUMENT
    -- rather than NOT_FOUND. Answering in-stream here matches grpc's
    -- canonical C++ implementation; Go instead terminates the RPC.
    Maybe (Proto ServerReflectionRequest'MessageRequest)
Nothing ->
      LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
forall (f :: * -> *) s a.
(Functor f, HasField s "errorResponse" a) =>
LensLike' f s a
V1.errorResponse LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
-> Proto ErrorResponse
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GrpcError -> Text -> Proto ErrorResponse
mkErrorResponse GrpcError
GrpcInvalidArgument Text
"no message_request set"
    Just (Proto ServerReflectionRequest'MessageRequest
messageRequest) -> case ServerReflectionRequest'MessageRequest
messageRequest of
      V1.ServerReflectionRequest'FileByFilename Text
fileName ->
        Text
-> Proto ServerReflectionResponse -> Proto ServerReflectionResponse
fileDescriptorAnswer Text
fileName
      V1.ServerReflectionRequest'FileContainingSymbol Text
symbolName ->
        case DescriptorTable -> Text -> Maybe Text
lookupSymbol DescriptorTable
table Text
symbolName of
          Maybe Text
Nothing -> LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
forall (f :: * -> *) s a.
(Functor f, HasField s "errorResponse" a) =>
LensLike' f s a
V1.errorResponse LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
-> Proto ErrorResponse
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GrpcError -> Text -> Proto ErrorResponse
mkErrorResponse GrpcError
GrpcNotFound (Text
"symbol not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
symbolName)
          Just Text
fileName -> Text
-> Proto ServerReflectionResponse -> Proto ServerReflectionResponse
fileDescriptorAnswer Text
fileName
      V1.ServerReflectionRequest'FileContainingExtension ExtensionRequest
extensionRequest ->
        LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
forall (f :: * -> *) s a.
(Functor f, HasField s "errorResponse" a) =>
LensLike' f s a
V1.errorResponse
          LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
-> Proto ErrorResponse
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GrpcError -> Text -> Proto ErrorResponse
mkErrorResponse
            GrpcError
GrpcNotFound
            ( Text
"no extensions are declared by this server (requested for type: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ExtensionRequest -> Proto ExtensionRequest
forall msg. msg -> Proto msg
Proto ExtensionRequest
extensionRequest Proto ExtensionRequest
-> Getting Text (Proto ExtensionRequest) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (Proto ExtensionRequest) Text
forall (f :: * -> *) s a.
(Functor f, HasField s "containingType" a) =>
LensLike' f s a
V1.containingType)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            )
      V1.ServerReflectionRequest'AllExtensionNumbersOfType Text
typeName ->
        case DescriptorTable -> Text -> Maybe Text
lookupSymbol DescriptorTable
table Text
typeName of
          Maybe Text
Nothing -> LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
forall (f :: * -> *) s a.
(Functor f, HasField s "errorResponse" a) =>
LensLike' f s a
V1.errorResponse LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
-> Proto ErrorResponse
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GrpcError -> Text -> Proto ErrorResponse
mkErrorResponse GrpcError
GrpcNotFound (Text
"type not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeName)
          Just Text
_ -> LensLike'
  Identity
  (Proto ServerReflectionResponse)
  (Proto ExtensionNumberResponse)
forall (f :: * -> *) s a.
(Functor f, HasField s "allExtensionNumbersResponse" a) =>
LensLike' f s a
V1.allExtensionNumbersResponse LensLike'
  Identity
  (Proto ServerReflectionResponse)
  (Proto ExtensionNumberResponse)
-> Proto ExtensionNumberResponse
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Proto ExtensionNumberResponse
forall msg. Message msg => msg
defMessage Proto ExtensionNumberResponse
-> (Proto ExtensionNumberResponse -> Proto ExtensionNumberResponse)
-> Proto ExtensionNumberResponse
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ExtensionNumberResponse) Text
forall (f :: * -> *) s a.
(Functor f, HasField s "baseTypeName" a) =>
LensLike' f s a
V1.baseTypeName LensLike' Identity (Proto ExtensionNumberResponse) Text
-> Text
-> Proto ExtensionNumberResponse
-> Proto ExtensionNumberResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
typeName)
      V1.ServerReflectionRequest'ListServices Text
_ ->
        LensLike'
  Identity
  (Proto ServerReflectionResponse)
  (Proto ListServiceResponse)
forall (f :: * -> *) s a.
(Functor f, HasField s "listServicesResponse" a) =>
LensLike' f s a
V1.listServicesResponse
          LensLike'
  Identity
  (Proto ServerReflectionResponse)
  (Proto ListServiceResponse)
-> Proto ListServiceResponse
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Proto ListServiceResponse
forall msg. Message msg => msg
defMessage Proto ListServiceResponse
-> (Proto ListServiceResponse -> Proto ListServiceResponse)
-> Proto ListServiceResponse
forall a b. a -> (a -> b) -> b
& LensLike'
  Identity (Proto ListServiceResponse) [Proto ServiceResponse]
forall (f :: * -> *) s a.
(Functor f, HasField s "service" a) =>
LensLike' f s a
V1.service LensLike'
  Identity (Proto ListServiceResponse) [Proto ServiceResponse]
-> [Proto ServiceResponse]
-> Proto ListServiceResponse
-> Proto ListServiceResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Text -> Proto ServiceResponse)
-> [Text] -> [Proto ServiceResponse]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
serviceName -> Proto ServiceResponse
forall msg. Message msg => msg
defMessage Proto ServiceResponse
-> (Proto ServiceResponse -> Proto ServiceResponse)
-> Proto ServiceResponse
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ServiceResponse) Text
forall (f :: * -> *) s a.
(Functor f, HasField s "name" a) =>
LensLike' f s a
V1.name LensLike' Identity (Proto ServiceResponse) Text
-> Text -> Proto ServiceResponse -> Proto ServiceResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
serviceName) [Text]
serviceNames)

  fileDescriptorAnswer
    :: Text -> Proto V1.ServerReflectionResponse -> Proto V1.ServerReflectionResponse
  fileDescriptorAnswer :: Text
-> Proto ServerReflectionResponse -> Proto ServerReflectionResponse
fileDescriptorAnswer Text
fileName = case DescriptorTable -> Text -> Maybe [FileEntry]
transitiveClosure DescriptorTable
table Text
fileName of
    Maybe [FileEntry]
Nothing -> LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
forall (f :: * -> *) s a.
(Functor f, HasField s "errorResponse" a) =>
LensLike' f s a
V1.errorResponse LensLike'
  Identity (Proto ServerReflectionResponse) (Proto ErrorResponse)
-> Proto ErrorResponse
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GrpcError -> Text -> Proto ErrorResponse
mkErrorResponse GrpcError
GrpcNotFound (Text
"file not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fileName)
    Just [FileEntry]
entries ->
      LensLike'
  Identity
  (Proto ServerReflectionResponse)
  (Proto FileDescriptorResponse)
forall (f :: * -> *) s a.
(Functor f, HasField s "fileDescriptorResponse" a) =>
LensLike' f s a
V1.fileDescriptorResponse LensLike'
  Identity
  (Proto ServerReflectionResponse)
  (Proto FileDescriptorResponse)
-> Proto FileDescriptorResponse
-> Proto ServerReflectionResponse
-> Proto ServerReflectionResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Proto FileDescriptorResponse
forall msg. Message msg => msg
defMessage Proto FileDescriptorResponse
-> (Proto FileDescriptorResponse -> Proto FileDescriptorResponse)
-> Proto FileDescriptorResponse
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto FileDescriptorResponse) [ByteString]
forall (f :: * -> *) s a.
(Functor f, HasField s "fileDescriptorProto" a) =>
LensLike' f s a
V1.fileDescriptorProto LensLike' Identity (Proto FileDescriptorResponse) [ByteString]
-> [ByteString]
-> Proto FileDescriptorResponse
-> Proto FileDescriptorResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (FileEntry -> ByteString) -> [FileEntry] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map FileEntry -> ByteString
fileEntryBytes [FileEntry]
entries)

  mkErrorResponse :: GrpcError -> Text -> Proto V1.ErrorResponse
  mkErrorResponse :: GrpcError -> Text -> Proto ErrorResponse
mkErrorResponse GrpcError
grpcError Text
message =
    Proto ErrorResponse
forall msg. Message msg => msg
defMessage
      Proto ErrorResponse
-> (Proto ErrorResponse -> Proto ErrorResponse)
-> Proto ErrorResponse
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ErrorResponse) Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "errorCode" a) =>
LensLike' f s a
V1.errorCode LensLike' Identity (Proto ErrorResponse) Int32
-> Int32 -> Proto ErrorResponse -> Proto ErrorResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GrpcError -> Word
fromGrpcError GrpcError
grpcError)
      Proto ErrorResponse
-> (Proto ErrorResponse -> Proto ErrorResponse)
-> Proto ErrorResponse
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ErrorResponse) Text
forall (f :: * -> *) s a.
(Functor f, HasField s "errorMessage" a) =>
LensLike' f s a
V1.errorMessage LensLike' Identity (Proto ErrorResponse) Text
-> Text -> Proto ErrorResponse -> Proto ErrorResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
message

-- | Re-encode a message as a wire-compatible message with different
-- generated Haskell types. Safe between schemas that agree on every field
-- number and wire type, which @v1@ and @v1alpha@ of the reflection protos
-- do (@v1alpha@ is @v1@ under its original package name); a future schema
-- divergence is reported as an @INTERNAL@ gRPC error rather than a panic.
bridgeMessage :: (Message a, Message b, MonadIO m) => Proto a -> m (Proto b)
bridgeMessage :: forall a b (m :: * -> *).
(Message a, Message b, MonadIO m) =>
Proto a -> m (Proto b)
bridgeMessage Proto a
message =
  (String -> m (Proto b))
-> (Proto b -> m (Proto b))
-> Either String (Proto b)
-> m (Proto b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GrpcError -> Text -> m (Proto b)
forall (m :: * -> *) a. MonadIO m => GrpcError -> Text -> m a
throwGrpcErrorWithMessage GrpcError
GrpcInternal (Text -> m (Proto b)) -> (String -> Text) -> String -> m (Proto b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"bridgeMessage: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) Proto b -> m (Proto b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Proto b) -> m (Proto b))
-> Either String (Proto b) -> m (Proto b)
forall a b. (a -> b) -> a -> b
$
    ByteString -> Either String (Proto b)
forall msg. Message msg => ByteString -> Either String msg
decodeMessage (Proto a -> ByteString
forall msg. Message msg => msg -> ByteString
encodeMessage Proto a
message)

-- | The fully qualified name of a proto service, @\<package\>.\<Service\>@,
-- read off its own compiled-in descriptor via proto-lens's 'Service' class.
-- Deriving it this way, rather than writing out the string, means the name
-- paired with each service's handler in "Cardano.Rpc.Server" and the name
-- 'answerReflectionRequest' (above) advertises for @list_services@ can
-- never drift apart.
qualifiedServiceName :: forall s. Service s => Text
qualifiedServiceName :: forall s. Service s => Text
qualifiedServiceName =
  String -> Text
Text.pack (Proxy (ServicePackage s) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(ServicePackage s)))
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Proxy (ServiceName s) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(ServiceName s)))