Improved hypermedia control management

source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st

@@ -25,7 +25,7 @@ PetsRESTfulWebServiceSpecification >> addJsonEncoderVersion1dot0dot0MappingIn: a
 							do: [ :mapping | 
 							mapping
 								mapInstVars;
-								mapProperty: #links getter: [ :thePet | (self mediaControlsIn: context) asDictionary ] setter: [ :object :value |  ] ];
+								mapHypermediaControlsIn: context ];
 						nextPut: pet ] ];
 		addRuleToEncode: self petMappingKey
 			to: self petSummaryVersion1dot0dot0MediaType
@@ -37,25 +37,22 @@ PetsRESTfulWebServiceSpecification >> addJsonEncoderVersion1dot0dot0MappingIn: a
 							do: [ :mapping | 
 							mapping
 								mapInstVar: #name;
-								mapProperty: #links getter: [ :thePet | (self mediaControlsIn: context) asDictionary ] setter: [ :object :value |  ] ];
+								mapHypermediaControlsIn: context ];
 						nextPut: pet ] ];
 		addDefaultRuleToEncode: self petsMappingKey
 			to: self petSummaryVersion1dot0dot0MediaType
 			using: [ :pets :context | 
 			String
 				streamContents: [ :stream | 
-					| individualMediaControls |
-
-					individualMediaControls := context objectUnder: #individualMediaControls ifNone: [ #() ].
 					(NeoJSONWriter on: stream)
 						for: Pet
 							do: [ :mapping | 
 							mapping
 								mapInstVar: #name;
-								mapProperty: #links getter: [ :pet | (individualMediaControls at: pet) asDictionary ] setter: [ :object :value |  ] ];
+								mapAsHypermediaControls: [ :pet | context hypermediaControlsFor: pet ] ];
 						nextPut:
 							{('items' -> pets).
-							('links' -> (self mediaControlsIn: context) asDictionary)} asDictionary ] ]
+							('links' -> context hypermediaControls asDictionary)} asDictionary ] ]
 ]
 
 { #category : #routes }
@@ -100,12 +97,6 @@ PetsRESTfulWebServiceSpecification >> identifierKey [
 	^ #identifier
 ]
 
-{ #category : #'mapping rules' }
-PetsRESTfulWebServiceSpecification >> mediaControlsIn: context [
-
-	^ context objectUnder: #mediaControls ifNone: [ #() ]
-]
-
 { #category : #accessing }
 PetsRESTfulWebServiceSpecification >> petMappingKey [
 

source/Stargate-REST-API/HttpRequestContext.class.st

@@ -1,3 +1,7 @@
+"
+I'm a context that gets created each time an Http Request is proceesed. I can carry contextual information to be easily used further in the processing pipeline.
+I also provide some facilities to manage Hypermedia Controls.
+"
 Class {
 	#name : #HttpRequestContext,
 	#superclass : #Object,
@@ -10,14 +14,45 @@ Class {
 { #category : #accessing }
 HttpRequestContext >> hold: anObject under: aConcept [
 
-	knownObjects at: aConcept put: anObject
+	knownObjects at: aConcept put: anObject.
+	^ anObject
+]
+
+{ #category : #hypermedia }
+HttpRequestContext >> holdAsHypermediaControls: aControlCollection [
+
+	self hold: aControlCollection under: #hypermediaControls
+]
+
+{ #category : #hypermedia }
+HttpRequestContext >> holdAsHypermediaControls: aControlCollection forSubresource: aResource [
+
+	| subResourcesHypermediaControls |
+
+	subResourcesHypermediaControls := self objectUnder: #subResourceHypermediaControls ifNone: [ self hold: IdentityDictionary new under: #subResourceHypermediaControls ].
+	subResourcesHypermediaControls at: aResource put: aControlCollection
+]
+
+{ #category : #hypermedia }
+HttpRequestContext >> hypermediaControls [
+
+	^ self objectUnder: #hypermediaControls ifNone: [ #() ]
+]
+
+{ #category : #hypermedia }
+HttpRequestContext >> hypermediaControlsFor: aResource [
+
+	| hypermediaControls |
+
+	hypermediaControls := self objectUnder: #subResourceHypermediaControls ifNone: [ ^ #() ].
+	^ hypermediaControls at: aResource ifAbsent: [ #() ]
 ]
 
 { #category : #initialization }
 HttpRequestContext >> initialize [
 
 	super initialize.
-	knownObjects := Dictionary new
+	knownObjects := IdentityDictionary new
 ]
 
 { #category : #accessing }

source/Stargate-REST-API/NeoJSONObjectMapping.extension.st

@@ -0,0 +1,13 @@
+Extension { #name : #NeoJSONObjectMapping }
+
+{ #category : #'*Stargate-REST-API' }
+NeoJSONObjectMapping >> mapAsHypermediaControls: aBlock [
+
+	self mapProperty: #links getter: [ :object | (aBlock cull: object) asDictionary ] setter: [ :object :value |  ]
+]
+
+{ #category : #'*Stargate-REST-API' }
+NeoJSONObjectMapping >> mapHypermediaControlsIn: aContext [
+
+	self mapAsHypermediaControls: [ aContext hypermediaControls ]
+]

source/Stargate-REST-API/RESTfulWebService.class.st

@@ -52,45 +52,38 @@ RESTfulWebService >> evaluateQuery: aQueryEvaluationBlock [
 { #category : #'private - API' }
 RESTfulWebService >> get: aQueryEvaluationBlock asCollectionEncodedUsing: aKey basedOn: anHttpRequest within: aContext [
 
-	| mediaType collection |
+	| mediaType |
 
 	mediaType := self targetMediaTypeFrom: anHttpRequest.
 
-	^ [ | encodedResult individualMediaControls |
+	^ [ | resourceCollection encodedResourceCollection |
 
-	collection := self evaluateQuery: aQueryEvaluationBlock.
-	individualMediaControls := IdentityDictionary new.
-	collection do: [ :individual | individualMediaControls at: individual put: (self mediaControlsFor: individual) ].
-	aContext
-		hold: {('self' -> anHttpRequest absoluteUrl printString)} under: #mediaControls;
-		hold: individualMediaControls under: #individualMediaControls.
-	encodedResult := self
-		encode: collection
+	resourceCollection := self evaluateQuery: aQueryEvaluationBlock.
+
+	aContext holdAsHypermediaControls: {('self' -> anHttpRequest absoluteUrl printString)}.
+	resourceCollection do: [ :resource | aContext holdAsHypermediaControls: (self mediaControlsFor: resource) forSubresource: resource ].
+
+	encodedResourceCollection := self
+		encode: resourceCollection
 		at: aKey
 		to: mediaType
 		within: aContext.
-	ZnResponse ok: encodedResult ]
+	ZnResponse ok: encodedResourceCollection ]
 		on: ConflictingObjectFound
 		do: [ :error | HTTPClientError signalConflict: error messageText ]
 ]
 
 { #category : #'private - API' }
 RESTfulWebService >> get: aQueryEvaluationBlock encodedUsing: aKey basedOn: anHttpRequest within: aContext [
 
-	| mediaType result |
+	| mediaType resource |
 
 	mediaType := self targetMediaTypeFrom: anHttpRequest.
 
-	^ [ | encodedResult |
-
-	result := self evaluateQuery: aQueryEvaluationBlock.
-	aContext hold: (self mediaControlsFor: result) under: #mediaControls.
-	encodedResult := self
-		encode: result
-		at: aKey
-		to: mediaType
-		within: aContext.
-	ZnResponse ok: encodedResult ]
+	^ [ 
+		resource := self evaluateQuery: aQueryEvaluationBlock.
+		aContext holdAsHypermediaControls: (self mediaControlsFor: resource).
+		ZnResponse ok: (self encode: resource at: aKey to: mediaType within: aContext) ]
 		on: ConflictingObjectFound
 		do: [ :error | HTTPClientError signalConflict: error messageText ]
 ]
@@ -141,17 +134,17 @@ RESTfulWebService >> targetMediaTypeFrom: anHttpRequest [
 { #category : #'private - API' }
 RESTfulWebService >> withCreatedResourceDo: aBlock decodedUsing: aKey basedOn: anHttpRequest within: aContext [
 
-	| resource newObject |
+	| decodedRepresentation newResource |
 
-	resource := self
+	decodedRepresentation := self
 		decode: anHttpRequest contents
 		at: aKey
 		from: anHttpRequest contentType
 		within: aContext.
 
-	newObject := [ aBlock value: resource ]
+	newResource := [ aBlock value: decodedRepresentation ]
 		on: ConflictingObjectFound
 		do: [ :signal | HTTPClientError signalConflict: signal messageText ].
 
-	^ ZnResponse created: (self locationOf: newObject)
+	^ ZnResponse created: (self locationOf: newResource)
 ]