Support subclassed MCP handlers and protocol domains

src/MCP-Tests-Resources/MCPSubclassHandlerTestServer.class.st

@@ -0,0 +1,17 @@
+"
+Test fixture MCP subclass used to verify inherited JSON-RPC handler registration and subclass handler overrides.
+"
+Class {
+	#name : 'MCPSubclassHandlerTestServer',
+	#superclass : 'MCP',
+	#category : 'MCP-Tests-Resources-Fixtures',
+	#package : 'MCP-Tests-Resources',
+	#tag : 'Fixtures'
+}
+
+{ #category : 'jrpc' }
+MCPSubclassHandlerTestServer >> rpcPing [
+
+	<jrpc: #ping>
+	^ { (#source -> 'subclass') } asDictionary
+]

src/MCP-Tests/MCPToolContractsTest.class.st

@@ -1455,6 +1455,21 @@ MCPToolContractsTest >> testInitializeAdvertisesSupportedPharoVersions [
 	self deny: runtimeVersion isEmpty
 ]
 
+{ #category : 'tests' }
+MCPToolContractsTest >> testInitializeAdvertisesSupportedProtocolDomains [
+
+	| capabilities response |
+	response := (self mcpWithoutObservabilityExport
+		             onInitialize: nil
+		             capabilities: nil
+		             clientInfo: nil
+		             websiteUrl: nil) asJRPCJSON.
+	capabilities := response at: #capabilities.
+	self assert: (capabilities at: #tools) equals: Dictionary new.
+	self assert: (capabilities at: #resources) equals: Dictionary new.
+	self assert: (capabilities at: #prompts) equals: Dictionary new
+]
+
 { #category : 'tests' }
 MCPToolContractsTest >> testInitializeResponseSerializesSupportedPharoVersions [
 
@@ -1524,6 +1539,32 @@ MCPToolContractsTest >> testMCPUnregisterToolNamedRefreshesStaticTools [
 	self deny: (server staticToolNames includes: MCPHaltingTestTool toolName)
 ]
 
+{ #category : 'tests' }
+MCPToolContractsTest >> testMessageProcessorRegistersInheritedMCPHandlersForSubclass [
+
+	| processor request response server |
+	server := MCPSubclassHandlerTestServer new.
+	processor := MCPMessageProcessor new.
+	processor addHandlersFromPragmasIn: server.
+	request := JRPCRequestObject id: 1 method: 'tools/list' params: Dictionary new.
+	response := processor handleJRPCRequestObject: request.
+	self assert: response class equals: JRPCSuccessResponseObject
+]
+
+{ #category : 'tests' }
+MCPToolContractsTest >> testMessageProcessorUsesSubclassJRPCHandlerOverride [
+
+	| processor request response result server |
+	server := MCPSubclassHandlerTestServer new.
+	processor := MCPMessageProcessor new.
+	processor addHandlersFromPragmasIn: server.
+	request := JRPCRequestObject id: 1 method: 'ping' params: Dictionary new.
+	response := processor handleJRPCRequestObject: request.
+	result := response result.
+	self assert: response class equals: JRPCSuccessResponseObject.
+	self assert: (result at: #source) equals: 'subclass'
+]
+
 { #category : 'tests' }
 MCPToolContractsTest >> testMethodMetadataSearchDescriptionPointsToSpecializedReferenceTools [
 
@@ -1816,6 +1857,23 @@ MCPToolContractsTest >> testProjectMethodsDoNotSendReflectiveProtocolChecks [
 				 (offendingMethods collect: [ :method | method printString ]) asArray printString })
 ]
 
+{ #category : 'tests' }
+MCPToolContractsTest >> testPromptsGetReturnsInvalidParamsWhenPromptIsUnknown [
+
+	| response |
+	response := self handleJSON: '{"jsonrpc":"2.0","id":1,"method":"prompts/get","params":{"name":"missing"}}'.
+	self assert: (response includesSubstring: '"code":-32602').
+	self assert: (response includesSubstring: '"message":"Invalid method parameter(s)."')
+]
+
+{ #category : 'tests' }
+MCPToolContractsTest >> testPromptsListReturnsEmptyPromptList [
+
+	| response |
+	response := self handleJSON: '{"jsonrpc":"2.0","id":1,"method":"prompts/list"}'.
+	self assert: (response includesSubstring: '"result":{"prompts":[]}')
+]
+
 { #category : 'tests' }
 MCPToolContractsTest >> testProtocolVersionNegotiation [
 
@@ -2008,6 +2066,31 @@ MCPToolContractsTest >> testRequestedToolIconsAreSelected [
 		equals: (MCPStructureIcon compositeBaseIconNamed: #pharoHalfScale badgeIconNamed: #go) asJRPCJSON
 ]
 
+{ #category : 'tests' }
+MCPToolContractsTest >> testResourcesListReturnsEmptyResourceList [
+
+	| response |
+	response := self handleJSON: '{"jsonrpc":"2.0","id":1,"method":"resources/list"}'.
+	self assert: (response includesSubstring: '"result":{"resources":[]}')
+]
+
+{ #category : 'tests' }
+MCPToolContractsTest >> testResourcesReadReturnsInvalidParamsWhenResourceIsUnknown [
+
+	| response |
+	response := self handleJSON: '{"jsonrpc":"2.0","id":1,"method":"resources/read","params":{"uri":"pharo://missing"}}'.
+	self assert: (response includesSubstring: '"code":-32602').
+	self assert: (response includesSubstring: '"message":"Invalid method parameter(s)."')
+]
+
+{ #category : 'tests' }
+MCPToolContractsTest >> testResourcesTemplatesListReturnsEmptyTemplateList [
+
+	| response |
+	response := self handleJSON: '{"jsonrpc":"2.0","id":1,"method":"resources/templates/list"}'.
+	self assert: (response includesSubstring: '"result":{"resourceTemplates":[]}')
+]
+
 { #category : 'tests' }
 MCPToolContractsTest >> testRewriteMethodsIsMethodScopedCommandTool [
 

src/MCP/MCP.class.st

@@ -326,7 +326,11 @@ MCP >> onInitialize: protocolVersion capabilities: capabilities clientInfo: clie
 	<jrpc: #initialize>
 	^ MCPStructureInitialize new
 		  protocolVersion: (self class negotiatedProtocolVersionFor: protocolVersion);
-		  capabilities: (MCPStructureCapabilities new tools: MCPStructureToolsCapabilities new);
+		  capabilities: (MCPStructureCapabilities new
+				   tools: MCPStructureToolsCapabilities new;
+				   resources: MCPStructureResourcesCapabilities new;
+				   prompts: MCPStructurePromptsCapabilities new;
+				   yourself);
 		  metadata: self serverInfrastructureMetadata;
 		  serverInfo: (MCPStructureServerInfo new
 				   name: 'MCP Pharo';
@@ -430,18 +434,39 @@ MCP >> rpcPing [
 	^ Dictionary new
 ]
 
+{ #category : 'rpc' }
+MCP >> rpcPromptGet: name arguments: arguments [
+
+	<jrpc: #'prompts/get'>
+	JRPCInvalidParameters signal
+]
+
+{ #category : 'rpc' }
+MCP >> rpcPromptsList [
+
+	<jrpc: #'prompts/list'>
+	^ { (#prompts -> #(  )) } asDictionary
+]
+
+{ #category : 'rpc' }
+MCP >> rpcResourceRead: uri [
+
+	<jrpc: #'resources/read'>
+	JRPCInvalidParameters signal
+]
+
 { #category : 'rpc' }
 MCP >> rpcResourcesList [
 
 	<jrpc: #'resources/list'>
-	^ { (#resource -> {  }) } asDictionary
+	^ { (#resources -> #(  )) } asDictionary
 ]
 
 { #category : 'rpc' }
 MCP >> rpcResourcesTemplateList [
 
 	<jrpc: #'resources/templates/list'>
-	^ { (#resourceTemplates -> {  }) } asDictionary
+	^ { (#resourceTemplates -> #(  )) } asDictionary
 ]
 
 { #category : 'rpc' }

src/MCP/MCPMessageProcessor.class.st

@@ -20,16 +20,22 @@ MCPMessageProcessor >> addHandler: aJRPCHandler [
 ]
 
 { #category : 'handlers management' }
-MCPMessageProcessor >> addHandlersFromPragmasIn: anObject [
+MCPMessageProcessor >> addHandlersFromPragmasFrom: aSubClass to: aSuperClass for: anObject [
 
-	(Pragma allNamed: #jrpc: in: anObject class) do: [ :pragma |
+	(Pragma allNamed: #jrpc: from: aSubClass to: aSuperClass) do: [ :pragma |
 			self addHandler: (MCPMessageSendHandler new
 					 receiver: anObject;
 					 methodName: pragma arguments first;
 					 messageSelector: pragma methodSelector;
 					 yourself) ]
 ]
 
+{ #category : 'handlers management' }
+MCPMessageProcessor >> addHandlersFromPragmasIn: anObject [
+
+	self addHandlersFromPragmasFrom: anObject class to: MCP for: anObject
+]
+
 { #category : 'handling - jrpc' }
 MCPMessageProcessor >> handleJRPCRequestObject: aJRPCRequestObject [
 

src/MCP/MCPStructurePromptsCapabilities.class.st

@@ -0,0 +1,36 @@
+"
+MCP protocol structure for the prompts capability.
+
+It records optional prompts capability flags advertised during initialization.
+"
+Class {
+	#name : 'MCPStructurePromptsCapabilities',
+	#superclass : 'Object',
+	#instVars : [
+		'listChanged'
+	],
+	#category : 'MCP-Structure',
+	#package : 'MCP',
+	#tag : 'Structure'
+}
+
+{ #category : 'accessing' }
+MCPStructurePromptsCapabilities >> asJRPCJSON [
+
+	| dictionary |
+	dictionary := Dictionary new.
+	self listChanged ifNotNil: [ dictionary at: #listChanged put: self listChanged asJRPCJSON ].
+	^ dictionary
+]
+
+{ #category : 'accessing' }
+MCPStructurePromptsCapabilities >> listChanged [
+
+	^ listChanged
+]
+
+{ #category : 'accessing' }
+MCPStructurePromptsCapabilities >> listChanged: anObject [
+
+	listChanged := anObject
+]

src/MCP/MCPStructureResourcesCapabilities.class.st

@@ -0,0 +1,50 @@
+"
+MCP protocol structure for the resources capability.
+
+It records optional resources capability flags advertised during initialization.
+"
+Class {
+	#name : 'MCPStructureResourcesCapabilities',
+	#superclass : 'Object',
+	#instVars : [
+		'subscribe',
+		'listChanged'
+	],
+	#category : 'MCP-Structure',
+	#package : 'MCP',
+	#tag : 'Structure'
+}
+
+{ #category : 'accessing' }
+MCPStructureResourcesCapabilities >> asJRPCJSON [
+
+	| dictionary |
+	dictionary := Dictionary new.
+	self listChanged ifNotNil: [ dictionary at: #listChanged put: self listChanged asJRPCJSON ].
+	self subscribe ifNotNil: [ dictionary at: #subscribe put: self subscribe asJRPCJSON ].
+	^ dictionary
+]
+
+{ #category : 'accessing' }
+MCPStructureResourcesCapabilities >> listChanged [
+
+	^ listChanged
+]
+
+{ #category : 'accessing' }
+MCPStructureResourcesCapabilities >> listChanged: anObject [
+
+	listChanged := anObject
+]
+
+{ #category : 'accessing' }
+MCPStructureResourcesCapabilities >> subscribe [
+
+	^ subscribe
+]
+
+{ #category : 'accessing' }
+MCPStructureResourcesCapabilities >> subscribe: anObject [
+
+	subscribe := anObject
+]