Add MCP profiles

docs/user/using-pharo-mcp.md

@@ -115,8 +115,25 @@ normal use, configure it through the `MCP` instance messages below. The
 instance; discoverable tools remain available through `tool_search`, `tool_get`,
 and `tool_call`.
 
-For per-server configuration, register tools explicitly before starting the
-server:
+For a server with only your own tools, use a profile:
+
+```smalltalk
+mcp := MCP profile: (MCPProfile tools: { MyProjectMCPTool }).
+mcp start.
+```
+
+`MCPProfile tools:` registers the given tools and advertises them directly in
+`tools/list`. Use `tools:static:` when some registered tools should stay
+discoverable through the catalog tools:
+
+```smalltalk
+mcp := MCP profile: (MCPProfile
+	tools: { MyProjectMCPTool. MyOtherMCPTool }
+	static: { MyProjectMCPTool }).
+```
+
+For incremental per-server configuration, register tools explicitly before
+starting the server:
 
 ```smalltalk
 mcp := MCP new.

src/MCP-Tests/MCPToolContractsTest.class.st

@@ -790,7 +790,7 @@ MCPToolContractsTest >> signalHaltForMCPMessageProcessorTest [
 MCPToolContractsTest >> testAllStaticExposurePolicyMakesEveryRegistrationStatic [
 
 	| registry |
-	registry := MCPToolRegistry new.
+	registry := MCPToolRegistry default.
 	registry exposurePolicy: MCPToolExposurePolicy allStatic.
 	self assert: registry staticToolNames asSet equals: registry publicToolNames asSet
 ]
@@ -948,7 +948,7 @@ MCPToolContractsTest >> testCaptureScreenshotHasAccurateNameAndSchemas [
 MCPToolContractsTest >> testCatalogToolsUseOwningRegistry [
 
 	| registry |
-	registry := MCPToolRegistry new.
+	registry := MCPToolRegistry default.
 	#( 'tool_search' 'tool_get' ) do: [ :toolName |
 			| tool |
 			tool := registry toolNamed: toolName ifAbsent: [ self fail ].
@@ -1161,6 +1161,24 @@ MCPToolContractsTest >> testDebuggerToolsAreDiscoverableOnly [
 	debugNames do: [ :each | self assert: (metadataByName includesKey: each) ]
 ]
 
+{ #category : 'tests' }
+MCPToolContractsTest >> testDefaultProfileUsesDefaultToolRegistry [
+
+	| server |
+	server := MCP new.
+	self assert: (server toolRegistry includesToolNamed: MCPToolSearchTools toolName).
+	self assert: (server staticToolNames includes: MCPToolSearchClasses toolName)
+]
+
+{ #category : 'tests' }
+MCPToolContractsTest >> testDefaultToolRegistryRegistersBuiltInTools [
+
+	| registry |
+	registry := MCPToolRegistry default.
+	self assert: (registry includesToolNamed: MCPToolSearchTools toolName).
+	self assert: (registry staticToolNames includes: MCPToolSearchClasses toolName)
+]
+
 { #category : 'tests' }
 MCPToolContractsTest >> testDictionaryShapedCommandResultsUseDTOClasses [
 
@@ -1216,6 +1234,16 @@ MCPToolContractsTest >> testDiscoveryUsesConfiguredStaticToolNames [
 	self deny: ((createContract at: #annotations) includesKey: #readOnlyHint)
 ]
 
+{ #category : 'tests' }
+MCPToolContractsTest >> testEmptyProfileRegistersNoTools [
+
+	| server |
+	server := MCP profile: MCPProfile empty.
+	self assert: server toolRegistry publicToolNames isEmpty.
+	self assert: server staticToolNames isEmpty.
+	self assert: (server rpcToolsList at: #tools) isEmpty
+]
+
 { #category : 'tests - evaluate' }
 MCPToolContractsTest >> testEvaluateCatchesHaltAsRuntimeFailure [
 
@@ -1284,7 +1312,7 @@ MCPToolContractsTest >> testEvaluateReturnsRuntimeFailureInformation [
 MCPToolContractsTest >> testExposurePolicyOverridesToolDefault [
 
 	| registry tool |
-	registry := MCPToolRegistry new.
+	registry := MCPToolRegistry default.
 	tool := registry toolNamed: 'method_protocol_update' ifAbsent: [ self fail ].
 	registry exposurePolicy: (MCPToolExposurePolicy staticToolNames: (registry staticToolNames copyWith: tool name)).
 	self assert: tool defaultExposure equals: 'discoverable'.
@@ -1768,6 +1796,15 @@ MCPToolContractsTest >> testMutationToolSchemasAdvertiseRenameScopeConditions [
 	self assert: (selectorInputSchema asJRPCJSON at: #additionalProperties) equals: false
 ]
 
+{ #category : 'tests' }
+MCPToolContractsTest >> testNewToolRegistryStartsEmpty [
+
+	| registry |
+	registry := MCPToolRegistry new.
+	self assert: registry publicToolNames isEmpty.
+	self assert: registry staticToolNames isEmpty
+]
+
 { #category : 'tests' }
 MCPToolContractsTest >> testOptionalToolArgumentsAdvertiseDefaultsWhenAvailable [
 
@@ -1832,6 +1869,31 @@ MCPToolContractsTest >> testParsedInputClassesUseRequestOrSpecSuffixes [
 	self assert: invalidNames isEmpty
 ]
 
+{ #category : 'tests' }
+MCPToolContractsTest >> testProfileCanKeepRegisteredToolsDiscoverable [
+
+	| server |
+	server := MCP profile: (MCPProfile
+			           tools: {
+					           MCPExternalTestTool.
+					           MCPToolSearchTools }
+			           static: { MCPExternalTestTool }).
+	self assert: server toolRegistry publicToolNames asSet equals: {
+			MCPExternalTestTool toolName.
+			MCPToolSearchTools toolName } asSet.
+	self assert: server staticToolNames asSet equals: { MCPExternalTestTool toolName } asSet.
+	self deny: ((server rpcToolsList at: #tools) anySatisfy: [ :each | (each at: #name) = MCPToolSearchTools toolName ])
+]
+
+{ #category : 'tests' }
+MCPToolContractsTest >> testProfileRegistersOnlyDeclaredTools [
+
+	| server |
+	server := MCP profile: (MCPProfile tools: { MCPExternalTestTool }).
+	self assert: server toolRegistry publicToolNames asSet equals: { MCPExternalTestTool toolName } asSet.
+	self assert: server staticToolNames asSet equals: { MCPExternalTestTool toolName } asSet
+]
+
 { #category : 'tests' }
 MCPToolContractsTest >> testProjectMethodsDoNotHandleMessageNotUnderstoodAsControlFlow [
 
@@ -2784,7 +2846,7 @@ MCPToolContractsTest >> testToolRegistryAutoRegistersOptInExternalTools [
 	^ true'
 			protocol: 'metadata'
 			on: toolClass classSide.
-		registry := MCPToolRegistry new.
+		registry := MCPToolRegistry default.
 		self assert: toolClass shouldAutoRegister.
 		self assert: (registry includesToolNamed: MCPExternalTestTool toolName).
 		self deny: (registry isStaticToolNamed: MCPExternalTestTool toolName) ] ensure: [ self removeClassNamed: className ]
@@ -2856,7 +2918,7 @@ MCPToolContractsTest >> testToolRegistryRegistrationIsInstanceScoped [
 MCPToolContractsTest >> testToolRegistryReusesRegisteredToolInstances [
 
 	| first registry searchResults second |
-	registry := MCPToolRegistry new.
+	registry := MCPToolRegistry default.
 	first := registry toolNamed: 'tool_search' ifAbsent: [ self fail ].
 	second := registry toolNamed: 'tool_search' ifAbsent: [ self fail ].
 	searchResults := registry toolsMatchingQuery: 'tool' group: nil.
@@ -2868,7 +2930,7 @@ MCPToolContractsTest >> testToolRegistryReusesRegisteredToolInstances [
 MCPToolContractsTest >> testToolRegistryUsesDefaultExposureUntilStaticListProvided [
 
 	| registry |
-	registry := MCPToolRegistry new.
+	registry := MCPToolRegistry default.
 	self assert: (registry isStaticToolNamed: 'tool_search').
 	self deny: (registry isStaticToolNamed: 'repository_search').
 	registry staticToolNames: #( 'repository_search' ).

src/MCP-Tests/MCPToolRepositoryOperationTest.class.st

@@ -13,7 +13,7 @@ Class {
 MCPToolRepositoryOperationTest >> callToolNamed: aToolName with: someArguments [
 
 	| request result tool |
-	tool := MCPToolRegistry new toolNamed: aToolName ifAbsent: [ Error signal: 'Unknown MCP tool: ' , aToolName ].
+	tool := MCPToolRegistry default toolNamed: aToolName ifAbsent: [ Error signal: 'Unknown MCP tool: ' , aToolName ].
 	request := tool requestFromToolCallArguments: someArguments.
 	result := tool executeWithRequest: request.
 	^ result asJRPCJSON

src/MCP/MCP.class.st

@@ -37,6 +37,14 @@ MCP class >> negotiatedProtocolVersionFor: requestedVersion [
 		  ifFalse: [ self latestProtocolVersion ]
 ]
 
+{ #category : 'instance creation' }
+MCP class >> profile: aProfile [
+
+	^ self new
+		  profile: aProfile;
+		  yourself
+]
+
 { #category : 'protocol' }
 MCP class >> supportedProtocolVersions [
 
@@ -92,6 +100,12 @@ MCP >> debugMode: aBoolean [
 	self server messageProcessor debugMode: aBoolean
 ]
 
+{ #category : 'configuration' }
+MCP >> defaultProfile [
+
+	^ MCPProfile default
+]
+
 { #category : 'private - saving' }
 MCP >> deferSaveImageAfterCurrentResponse [
 
@@ -200,10 +214,10 @@ MCP >> handlersCount [
 MCP >> initialize [
 
 	super initialize.
-	self refreshToolsList.
 	server := MCPHTTPServer new.
 	server addHandlersFromPragmasIn: self.
-	observability := MCPNoopObservabilityBackend new
+	observability := MCPNoopObservabilityBackend new.
+	self profile: self defaultProfile
 ]
 
 { #category : 'testing' }
@@ -363,6 +377,12 @@ MCP >> port: aPortNumber [
 	self server port: aPortNumber
 ]
 
+{ #category : 'configuration' }
+MCP >> profile: aProfile [
+
+	aProfile applyTo: self
+]
+
 { #category : 'private - tools' }
 MCP >> recordToolCallWrapperStartFor: callTool arguments: arguments [
 
@@ -601,13 +621,13 @@ MCP >> toolExposurePolicy: aToolExposurePolicy [
 { #category : 'accessing' }
 MCP >> toolRegistry [
 
-	^ toolRegistry ifNil: [ toolRegistry := MCPToolRegistry new ]
+	^ toolRegistry ifNil: [ toolRegistry := MCPToolRegistry default ]
 ]
 
 { #category : 'accessing' }
 MCP >> toolRegistry: aToolRegistry [
 
-	toolRegistry := aToolRegistry ifNil: [ MCPToolRegistry new ].
+	toolRegistry := aToolRegistry ifNil: [ MCPToolRegistry default ].
 	self refreshToolsList
 ]
 

src/MCP/MCPGetToolCommand.class.st

@@ -14,7 +14,7 @@ Class {
 { #category : 'instance creation' }
 MCPGetToolCommand class >> tool: aTool request: aRequest [
 
-	^ self tool: aTool request: aRequest toolRegistry: MCPToolRegistry new
+	^ self tool: aTool request: aRequest toolRegistry: MCPToolRegistry default
 ]
 
 { #category : 'executing' }

src/MCP/MCPProfile.class.st

@@ -0,0 +1,94 @@
+"
+An MCP profile declares the server capabilities a server instance should expose. It currently configures the tool registry and is intended to grow with resource and prompt registries.
+"
+Class {
+	#name : 'MCPProfile',
+	#superclass : 'Object',
+	#instVars : [
+		'toolClasses',
+		'staticToolClasses'
+	],
+	#category : 'MCP-Server',
+	#package : 'MCP',
+	#tag : 'Server'
+}
+
+{ #category : 'instance creation' }
+MCPProfile class >> default [
+
+	^ self new
+]
+
+{ #category : 'instance creation' }
+MCPProfile class >> empty [
+
+	^ self tools: #(  )
+]
+
+{ #category : 'instance creation' }
+MCPProfile class >> tools: toolClasses [
+
+	^ self tools: toolClasses static: toolClasses
+]
+
+{ #category : 'instance creation' }
+MCPProfile class >> tools: toolClasses static: staticToolClasses [
+
+	^ self new
+		  toolClasses: toolClasses;
+		  staticToolClasses: staticToolClasses;
+		  yourself
+]
+
+{ #category : 'applying' }
+MCPProfile >> applyTo: anMCP [
+
+	anMCP toolRegistry: self toolRegistry
+]
+
+{ #category : 'private' }
+MCPProfile >> configuredToolRegistry [
+
+	| registry |
+	registry := MCPToolRegistry empty.
+	registry registerToolClasses: self toolClasses.
+	self staticToolClasses ifNotNil: [ registry staticToolNames: (self staticToolClasses collect: [ :each | each toolName ]) ].
+	^ registry
+]
+
+{ #category : 'accessing' }
+MCPProfile >> staticToolClasses [
+
+	^ staticToolClasses
+]
+
+{ #category : 'accessing' }
+MCPProfile >> staticToolClasses: aCollection [
+
+	staticToolClasses := aCollection
+]
+
+{ #category : 'accessing' }
+MCPProfile >> toolClasses [
+
+	^ toolClasses
+]
+
+{ #category : 'accessing' }
+MCPProfile >> toolClasses: aCollection [
+
+	toolClasses := aCollection
+]
+
+{ #category : 'accessing' }
+MCPProfile >> toolRegistry [
+
+	self usesDefaultTools ifTrue: [ ^ MCPToolRegistry default ].
+	^ self configuredToolRegistry
+]
+
+{ #category : 'testing' }
+MCPProfile >> usesDefaultTools [
+
+	^ self toolClasses isNil
+]

src/MCP/MCPSearchToolsCommand.class.st

@@ -14,7 +14,7 @@ Class {
 { #category : 'instance creation' }
 MCPSearchToolsCommand class >> tool: aTool request: aRequest [
 
-	^ self tool: aTool request: aRequest toolRegistry: MCPToolRegistry new
+	^ self tool: aTool request: aRequest toolRegistry: MCPToolRegistry default
 ]
 
 { #category : 'executing' }

src/MCP/MCPTool.class.st

@@ -141,7 +141,7 @@ MCPTool class >> toolCatalogGroupName [
 { #category : 'scripts' }
 MCPTool class >> toolGroups [
 
-	^ MCPToolRegistry new publicToolGroups
+	^ MCPToolRegistry default publicToolGroups
 ]
 
 { #category : 'scripts' }

src/MCP/MCPToolGetTool.class.st

@@ -157,7 +157,7 @@ MCPToolGetTool >> title [
 { #category : 'accessing' }
 MCPToolGetTool >> toolRegistry [
 
-	^ toolRegistry ifNil: [ toolRegistry := MCPToolRegistry new ]
+	^ toolRegistry ifNil: [ toolRegistry := MCPToolRegistry default ]
 ]
 
 { #category : 'accessing' }