|
| 1 | +{-# LANGUAGE AllowAmbiguousTypes #-} |
| 2 | +{-# LANGUAGE LambdaCase #-} |
| 3 | +{-# LANGUAGE ScopedTypeVariables #-} |
| 4 | +{-# LANGUAGE TypeApplications #-} |
| 5 | + |
| 6 | +-- | Handler for the gRPC Server Reflection API |
| 7 | +-- (<https://github.com/grpc/grpc/blob/master/doc/server-reflection.md>), |
| 8 | +-- @grpc.reflection.v1@ and the older @grpc.reflection.v1alpha@. This lets |
| 9 | +-- generic clients (e.g. @grpcurl@) discover and decode this server's proto |
| 10 | +-- services without a local copy of the @.proto@ files. |
| 11 | +module Cardano.Rpc.Server.Internal.Reflection |
| 12 | + ( serverReflectionInfoMethodV1 |
| 13 | + , serverReflectionInfoMethodV1alpha |
| 14 | + , answerReflectionRequest |
| 15 | + , qualifiedServiceName |
| 16 | + ) |
| 17 | +where |
| 18 | + |
| 19 | +import Cardano.Rpc.Proto.Api.Reflection.V1 qualified as V1 |
| 20 | +import Cardano.Rpc.Proto.Api.Reflection.V1alpha qualified as V1alpha |
| 21 | +import Cardano.Rpc.Server.Internal.Reflection.DescriptorTable |
| 22 | + |
| 23 | +import RIO |
| 24 | + |
| 25 | +import Data.ProtoLens (Message, decodeMessageOrDie, defMessage, encodeMessage) |
| 26 | +import Data.ProtoLens.Service.Types (Service, ServiceName, ServicePackage) |
| 27 | +import Data.Text qualified as Text |
| 28 | +import GHC.TypeLits (symbolVal) |
| 29 | +import Network.GRPC.Spec |
| 30 | + ( GrpcError (GrpcInvalidArgument, GrpcNotFound) |
| 31 | + , NextElem (NextElem, NoNextElem) |
| 32 | + , Proto (Proto) |
| 33 | + , fromGrpcError |
| 34 | + ) |
| 35 | + |
| 36 | +-- | The fully qualified name of a proto service, @\<package\>.\<Service\>@, |
| 37 | +-- read off its own compiled-in descriptor via proto-lens's 'Service' class. |
| 38 | +-- Deriving it this way, rather than writing out the string, means the name |
| 39 | +-- registered with grapesy ("Server.hs") and the name advertised by |
| 40 | +-- @list_services@ (below) can never drift apart. |
| 41 | +qualifiedServiceName :: forall s. Service s => Text |
| 42 | +qualifiedServiceName = |
| 43 | + Text.pack (symbolVal (Proxy @(ServicePackage s))) |
| 44 | + <> "." |
| 45 | + <> Text.pack (symbolVal (Proxy @(ServiceName s))) |
| 46 | + |
| 47 | +-- | Handle the @ServerReflectionInfo@ bidirectional stream for |
| 48 | +-- @grpc.reflection.v1@: answer every request on the incoming stream in |
| 49 | +-- turn, then forward the client's own terminal marker. A bidi handler that |
| 50 | +-- returns without sending 'NoNextElem' itself has its stream cancelled |
| 51 | +-- instead of closed with trailers, the same requirement as for |
| 52 | +-- server-streaming handlers (both go through grapesy's identical |
| 53 | +-- @sendOutput call . fromNextElem call@ path). |
| 54 | +serverReflectionInfoMethodV1 |
| 55 | + :: MonadIO m |
| 56 | + => [Text] |
| 57 | + -- ^ Fully qualified names of every service registered with this server, |
| 58 | + -- answered verbatim for @list_services@ |
| 59 | + -> IO (NextElem (Proto V1.ServerReflectionRequest)) |
| 60 | + -> (NextElem (Proto V1.ServerReflectionResponse) -> IO ()) |
| 61 | + -> m () |
| 62 | +serverReflectionInfoMethodV1 serviceNames recv send = liftIO loop |
| 63 | + where |
| 64 | + loop = |
| 65 | + recv >>= \case |
| 66 | + NoNextElem -> send NoNextElem |
| 67 | + NextElem request -> do |
| 68 | + send . NextElem $ answerReflectionRequest descriptorTable serviceNames request |
| 69 | + loop |
| 70 | + |
| 71 | +-- | Handle the same stream for the legacy @grpc.reflection.v1alpha@, by |
| 72 | +-- bridging each message to and from @v1@ and answering with the one core |
| 73 | +-- 'answerReflectionRequest'. |
| 74 | +serverReflectionInfoMethodV1alpha |
| 75 | + :: MonadIO m |
| 76 | + => [Text] |
| 77 | + -> IO (NextElem (Proto V1alpha.ServerReflectionRequest)) |
| 78 | + -> (NextElem (Proto V1alpha.ServerReflectionResponse) -> IO ()) |
| 79 | + -> m () |
| 80 | +serverReflectionInfoMethodV1alpha serviceNames recv send = liftIO loop |
| 81 | + where |
| 82 | + loop = |
| 83 | + recv >>= \case |
| 84 | + NoNextElem -> send NoNextElem |
| 85 | + NextElem request -> do |
| 86 | + send . NextElem . bridgeMessage $ |
| 87 | + answerReflectionRequest descriptorTable serviceNames (bridgeMessage request) |
| 88 | + loop |
| 89 | + |
| 90 | +-- | Re-encode a message as a wire-compatible message with different |
| 91 | +-- generated Haskell types. Safe only between schemas that agree on every |
| 92 | +-- field number and wire type, which @v1@ and @v1alpha@ of the reflection |
| 93 | +-- protos do (@v1alpha@ is @v1@ under its original package name). |
| 94 | +bridgeMessage :: (Message a, Message b) => Proto a -> Proto b |
| 95 | +bridgeMessage = decodeMessageOrDie . encodeMessage |
| 96 | + |
| 97 | +-- | Answer one @ServerReflectionRequest@, dispatching on its |
| 98 | +-- @message_request@ oneof. |
| 99 | +-- |
| 100 | +-- Lookup failures ('V1.FileByFilename', 'V1.FileContainingSymbol') are |
| 101 | +-- reported in-stream as an @ErrorResponse@ with @NOT_FOUND@, never as a |
| 102 | +-- gRPC error: the RPC itself stays OK for the life of the stream. |
| 103 | +-- @file_containing_extension@ and @all_extension_numbers_of_type@ also |
| 104 | +-- answer @NOT_FOUND@, since none of the proto files served here declare |
| 105 | +-- proto2 extensions. |
| 106 | +answerReflectionRequest |
| 107 | + :: DescriptorTable |
| 108 | + -> [Text] |
| 109 | + -> Proto V1.ServerReflectionRequest |
| 110 | + -> Proto V1.ServerReflectionResponse |
| 111 | +answerReflectionRequest table serviceNames request = |
| 112 | + defMessage |
| 113 | + & V1.validHost .~ (request ^. V1.host) |
| 114 | + & V1.originalRequest .~ request |
| 115 | + & answer |
| 116 | + where |
| 117 | + answer :: Proto V1.ServerReflectionResponse -> Proto V1.ServerReflectionResponse |
| 118 | + answer = case request ^. V1.maybe'messageRequest of |
| 119 | + -- proto3 leaves message_request entirely unset when malformed by the |
| 120 | + -- client; there is no lookup to fail here, so this is INVALID_ARGUMENT |
| 121 | + -- rather than NOT_FOUND. |
| 122 | + Nothing -> |
| 123 | + V1.errorResponse .~ mkErrorResponse GrpcInvalidArgument "no message_request set" |
| 124 | + Just (Proto messageRequest) -> case messageRequest of |
| 125 | + V1.ServerReflectionRequest'FileByFilename fileName -> |
| 126 | + fileDescriptorAnswer fileName |
| 127 | + V1.ServerReflectionRequest'FileContainingSymbol symbolName -> |
| 128 | + case lookupSymbol table symbolName of |
| 129 | + Nothing -> V1.errorResponse .~ mkErrorResponse GrpcNotFound ("symbol not found: " <> symbolName) |
| 130 | + Just fileName -> fileDescriptorAnswer fileName |
| 131 | + V1.ServerReflectionRequest'FileContainingExtension extensionRequest -> |
| 132 | + V1.errorResponse |
| 133 | + .~ mkErrorResponse |
| 134 | + GrpcNotFound |
| 135 | + ( "no extensions are declared by this server (requested for type: " |
| 136 | + <> (Proto extensionRequest ^. V1.containingType) |
| 137 | + <> ")" |
| 138 | + ) |
| 139 | + V1.ServerReflectionRequest'AllExtensionNumbersOfType typeName -> |
| 140 | + V1.errorResponse |
| 141 | + .~ mkErrorResponse GrpcNotFound ("no extensions are declared of type: " <> typeName) |
| 142 | + V1.ServerReflectionRequest'ListServices _ -> |
| 143 | + V1.listServicesResponse |
| 144 | + .~ (defMessage & V1.service .~ map (\serviceName -> defMessage & V1.name .~ serviceName) serviceNames) |
| 145 | + |
| 146 | + fileDescriptorAnswer |
| 147 | + :: Text -> Proto V1.ServerReflectionResponse -> Proto V1.ServerReflectionResponse |
| 148 | + fileDescriptorAnswer fileName = case transitiveClosure table fileName of |
| 149 | + Nothing -> V1.errorResponse .~ mkErrorResponse GrpcNotFound ("file not found: " <> fileName) |
| 150 | + Just entries -> |
| 151 | + V1.fileDescriptorResponse .~ (defMessage & V1.fileDescriptorProto .~ map fileEntryBytes entries) |
| 152 | + |
| 153 | + mkErrorResponse :: GrpcError -> Text -> Proto V1.ErrorResponse |
| 154 | + mkErrorResponse grpcError message = |
| 155 | + defMessage |
| 156 | + & V1.errorCode .~ fromIntegral (fromGrpcError grpcError) |
| 157 | + & V1.errorMessage .~ message |
0 commit comments