Merge pull request #58 from ba-st/improvements

Minor improvements

source/Stargate-Examples-Tests/PetOrdersRESTfulControllerTest.class.st

@@ -16,7 +16,7 @@ PetOrdersRESTfulControllerTest >> baseUrl [
 	^ 'https://petstore.example.com' asUrl
 ]
 
-{ #category : #'tests - comments' }
+{ #category : #'private - support' }
 PetOrdersRESTfulControllerTest >> commentsRelatedTo: order [
 
 	^ resourceController
@@ -410,25 +410,34 @@ PetOrdersRESTfulControllerTest >> testHATEOAS [
 			self
 				assertUrl: json pet equals: self petUrl;
 				assert: json status equals: 'registered';
-				assertUrl: json links self equals: 'https://petstore.example.com/orders/1';
+				assertUrl: json selfLocation equals: 'https://petstore.example.com/orders/1';
 				assertUrl: json links cancel equals: 'https://petstore.example.com/orders/1/cancel';
 				assertUrl: json links complete equals: 'https://petstore.example.com/orders/1/complete';
-				assert: (resourceController completeOrderBasedOn: (self requestToPOST: json links complete identifiedBy: 1) within: self newHttpRequestContext) isSuccess ];
+				assert:
+					( resourceController
+						completeOrderBasedOn: ( self requestToPOST: json links complete identifiedBy: 1 )
+						within: self newHttpRequestContext ) isSuccess
+			];
 		getFirstOrderAndWithJsonDo: [ :json | 
 			self
 				assertUrl: json pet equals: self petUrl;
 				assert: json status equals: 'completed';
-				assertUrl: json links self equals: 'https://petstore.example.com/orders/1';
+				assertUrl: json selfLocation equals: 'https://petstore.example.com/orders/1';
 				assertUrl: json links cancel equals: 'https://petstore.example.com/orders/1/cancel';
 				assert: json links complete isNil;
-				assert: (resourceController cancelOrderBasedOn: (self requestToPOST: json links cancel identifiedBy: 1) within: self newHttpRequestContext) isSuccess ];
+				assert:
+					( resourceController
+						cancelOrderBasedOn: ( self requestToPOST: json links cancel identifiedBy: 1 )
+						within: self newHttpRequestContext ) isSuccess
+			];
 		getFirstOrderAndWithJsonDo: [ :json | 
 			self
 				assertUrl: json pet equals: self petUrl;
 				assert: json status equals: 'canceled';
-				assertUrl: json links self equals: 'https://petstore.example.com/orders/1';
+				assertUrl: json selfLocation equals: 'https://petstore.example.com/orders/1';
 				assert: json links cancel isNil;
-				assert: json links complete isNil ]
+				assert: json links complete isNil
+			]
 ]
 
 { #category : #'tests - orders' }

source/Stargate-Examples-Tests/PetStoreAPITest.class.st

@@ -174,7 +174,7 @@ PetStoreAPITest >> testCreatePet [
 		assert: json status equals: 'new';
 		assert: json name equals: 'Firulais';
 		assert: json type equals: 'dog';
-		assert: json links self equals: response location
+		assert: json selfLocation equals: response location
 ]
 
 { #category : #tests }

source/Stargate-Examples-Tests/PetsRESTfulControllerTest.class.st

@@ -183,7 +183,7 @@ PetsRESTfulControllerTest >> testComplexPagination [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assertUrl: json links self equals: 'https://pets.example.com/pets?limit=2';
+				assertUrl: json selfLocation equals: 'https://pets.example.com/pets?limit=2';
 				assertUrl: json links next equals: 'https://pets.example.com/pets?start=3&limit=2';
 				assertUrl: json links last equals: 'https://pets.example.com/pets?start=5&limit=2';
 				assert: json items size equals: 2
@@ -212,7 +212,7 @@ PetsRESTfulControllerTest >> testComplexPagination [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assertUrl: json links self asZnUrl equals: 'https://pets.example.com/pets?start=3&limit=2';
+				assertUrl: json selfLocation asZnUrl equals: 'https://pets.example.com/pets?start=3&limit=2';
 				assertUrl: json links first asZnUrl equals: 'https://pets.example.com/pets?start=1&limit=2';
 				assertUrl: json links prev asZnUrl equals: 'https://pets.example.com/pets?start=1&limit=2';
 				assertUrl: json links next asZnUrl equals: 'https://pets.example.com/pets?start=5&limit=2';
@@ -404,7 +404,7 @@ PetsRESTfulControllerTest >> testGetPets [
 		do: [ :json | 
 			self
 				assert: json items isEmpty;
-				assertUrl: json links self equals: 'https://pets.example.com/pets'
+				assertUrl: json selfLocation equals: 'https://pets.example.com/pets'
 			]
 ]
 
@@ -431,17 +431,17 @@ PetsRESTfulControllerTest >> testGetPetsNotEmpty [
 
 	self
 		withJsonFromContentsIn: response
-		do: [ :json | 
-			| dogSummary |
-
-			self
-				assertUrl: json links self equals: 'https://pets.example.com/pets';
-				assert: json items size equals: 1.
-			dogSummary := json items first.
+			do: [ :json | self assertUrl: json selfLocation equals: 'https://pets.example.com/pets' ];
+		withJsonFromItemsIn: response
+			do: [ :items | 
 			self
-				assert: dogSummary name equals: 'Firulais';
-				assertUrl: dogSummary links self equals: 'https://pets.example.com/pets/1';
-				assert: dogSummary type isNil
+				withTheOnlyOneIn: items
+				do: [ :dogSummary | 
+					self
+						assert: dogSummary name equals: 'Firulais';
+						assertUrl: dogSummary selfLocation equals: 'https://pets.example.com/pets/1';
+						assert: dogSummary type isNil
+					]
 			]
 ]
 
@@ -471,7 +471,7 @@ PetsRESTfulControllerTest >> testGetPetsWithPagination [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assertUrl: json links self equals: 'https://pets.example.com/pets';
+				assertUrl: json selfLocation equals: 'https://pets.example.com/pets';
 				assertUrl: json links next equals: 'https://pets.example.com/pets?start=6&limit=5';
 				assertUrl: json links last equals: 'https://pets.example.com/pets?start=6&limit=5';
 				assert: json items size equals: 5.
@@ -493,7 +493,7 @@ PetsRESTfulControllerTest >> testGetPetsWithPagination [
 				withJsonFromContentsIn: response
 				do: [ :json2 | 
 					self
-						assertUrl: json2 links self equals: 'https://pets.example.com/pets?start=6&limit=5';
+						assertUrl: json2 selfLocation equals: 'https://pets.example.com/pets?start=6&limit=5';
 						assertUrl: json2 links first equals: 'https://pets.example.com/pets?start=1&limit=5';
 						assertUrl: json2 links prev equals: 'https://pets.example.com/pets?start=1&limit=5';
 						assert: json2 links next isNil;

source/Stargate-Model/NeoJSONObject.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #NeoJSONObject }
+
+{ #category : #'*Stargate-Model' }
+NeoJSONObject >> selfLocation [
+
+	^ self links self
+]

source/Stargate-Model/NeoJSONObjectMapping.extension.st

@@ -11,11 +11,11 @@ NeoJSONObjectMapping >> mapAsHypermediaControls: aBlock [
 { #category : #'*Stargate-Model' }
 NeoJSONObjectMapping >> mapProperty: propertyName getter: readBlock [
 
-	self mapProperty: propertyName getter: readBlock setter: [:object :value | ]
+	^ self mapProperty: propertyName getter: readBlock setter: [ :object :value |  ]
 ]
 
 { #category : #'*Stargate-Model' }
 NeoJSONObjectMapping >> mapProperty: propertyName setter: writeBlock [
 
-	self mapProperty: propertyName getter: [ :object |  ] setter: writeBlock
+	^ self mapProperty: propertyName getter: [ :object |  ] setter: writeBlock
 ]

source/Stargate-Model/RESTfulRequestHandlerBehavior.class.st

@@ -11,8 +11,7 @@ Class {
 		'encodingRules',
 		'entityTagCalculator',
 		'acceptNegotiator',
-		'resourceLocator',
-		'exceptionHandler'
+		'resourceLocator'
 	],
 	#category : #'Stargate-Model-Controllers'
 }
@@ -33,7 +32,7 @@ RESTfulRequestHandlerBehavior >> decode: httpRequest within: requestContext [
 		at: httpRequest contentType
 		ifAbsent: [ HTTPClientError unsupportedMediaType signal: 'Decoder not found for given media type' ].
 
-	^ exceptionHandler
+	^ self exceptionHandler
 		handleDecodingFailedDuring: [ decodingRule cull: httpRequest contents cull: requestContext ]
 ]
 
@@ -84,7 +83,13 @@ RESTfulRequestHandlerBehavior >> entityTagToMatchBasedOn: httpRequest [
 { #category : #private }
 RESTfulRequestHandlerBehavior >> evaluateCollectionQuery: aQueryEvaluationBlock [
 
-	^ exceptionHandler handleMissingQueryParametersDuring: aQueryEvaluationBlock
+	^ self exceptionHandler handleMissingQueryParametersDuring: aQueryEvaluationBlock
+]
+
+{ #category : #accessing }
+RESTfulRequestHandlerBehavior >> exceptionHandler [
+
+	^ resourceLocator exceptionHandler
 ]
 
 { #category : #API }
@@ -94,7 +99,7 @@ RESTfulRequestHandlerBehavior >> from: httpRequest within: requestContext get: a
 
 	mediaType := self targetMediaTypeFrom: httpRequest.
 	resource := resourceLocator
-		lookupResouceIdentifiedBy: httpRequest
+		lookupResourceIdentifiedBy: httpRequest
 		evaluating: aQueryEvaluationBlock.
 	self
 		ifNoneMatchHeaderPresentIn: httpRequest
@@ -120,9 +125,9 @@ RESTfulRequestHandlerBehavior >> from: httpRequest within: requestContext get: a
 	| resource |
 
 	resource := resourceLocator
-		lookupResouceIdentifiedBy: httpRequest
+		lookupResourceIdentifiedBy: httpRequest
 		evaluating: aQueryEvaluationBlock.
-	exceptionHandler handleConflictsDuring: [ actionBlock value: resource ].
+	self exceptionHandler handleConflictsDuring: [ actionBlock value: resource ].
 	^ ZnResponse noContent
 ]
 
@@ -147,7 +152,7 @@ RESTfulRequestHandlerBehavior >> from: httpRequest within: requestContext get: f
 				within: requestContext.
 
 			updatedResource := self decode: httpRequest within: requestContext.
-			exceptionHandler
+			self exceptionHandler
 				handleConflictsDuring: [ updateBlock value: resourceToUpdate value: updatedResource ]
 			]
 ]
@@ -183,14 +188,14 @@ RESTfulRequestHandlerBehavior >> initializeResourceLocator: aResouceLocator
 	calculateEntityTagsWith: anEntityTagCalculator
 	handleErrorsWith: anExceptionHandler [
 
+
 	resourceLocator := aResouceLocator.
 	resourceLocator handleExceptionsWith: anExceptionHandler.
 	paginationPolicy := aPaginationPolicy cull: self.
 	decodingRules := theDecodingRules.
 	encodingRules := theEncodingRules.
 	acceptNegotiator := RESTfulControllerAcceptNegotiator basedOn: encodingRules keys.
-	entityTagCalculator := anEntityTagCalculator.
-	exceptionHandler := anExceptionHandler
+	entityTagCalculator := anEntityTagCalculator
 ]
 
 { #category : #private }
@@ -247,7 +252,10 @@ RESTfulRequestHandlerBehavior >> withRepresentationIn: httpRequest within: reque
 	^ self
 		withResourceCreatedFrom: httpRequest
 		within: requestContext
-		do: [ :representation | aBlock value: ( aCreationBlock value: representation ) ]
+		do: [ :representation | 
+			aBlock
+				value: ( self exceptionHandler handleDecodingFailedDuring: [ aCreationBlock value: representation ] )
+			]
 ]
 
 { #category : #API }
@@ -257,6 +265,6 @@ RESTfulRequestHandlerBehavior >> withResourceCreatedFrom: httpRequest within: re
 
 	creationPolicy := self resourceCreationPolicyBasedOn: httpRequest.
 	decodedRepresentation := self decode: httpRequest within: requestContext.
-	newResource := exceptionHandler handleConflictsDuring: [ aBlock value: decodedRepresentation ].
+	newResource := self exceptionHandler handleConflictsDuring: [ aBlock value: decodedRepresentation ].
 	^ creationPolicy responseFor: newResource basedOn: httpRequest within: requestContext
 ]

source/Stargate-Model/RESTfulRequestHandlerBuilder.class.st

@@ -175,13 +175,30 @@ RESTfulRequestHandlerBuilder >> whenResponding: aMediaType encodeApplying: anEnc
 { #category : #encoding }
 RESTfulRequestHandlerBuilder >> whenResponding: aMediaType encodeToJsonApplying: aBlock [
 
+	self
+		whenResponding: aMediaType
+		encodeToJsonApplying: aBlock
+		writingResourceWith: [ :writer :resource | writer nextPut: resource ]
+]
+
+{ #category : #encoding }
+RESTfulRequestHandlerBuilder >> whenResponding: aMediaType encodeToJsonApplying: aBlock as: schema [
+
+	self
+		whenResponding: aMediaType
+		encodeToJsonApplying: aBlock
+		writingResourceWith: [ :writer :resource | writer nextPut: resource as: schema ]
+]
+
+{ #category : #encoding }
+RESTfulRequestHandlerBuilder >> whenResponding: aMediaType encodeToJsonApplying: aBlock writingResourceWith: aResourceWritingBlock [
+
 	self
 		whenResponding: aMediaType
 		encodeApplying: [ :resource :requestContext | 
 			String
 				streamContents: [ :stream | 
 					| writer |
-
 					writer := NeoJSONWriter on: stream.
 					aBlock value: resource value: requestContext value: writer.
 					writer
@@ -191,7 +208,7 @@ RESTfulRequestHandlerBuilder >> whenResponding: aMediaType encodeToJsonApplying:
 								mapInstVar: #items;
 								mapAsHypermediaControls: [ :collection | requestContext hypermediaControlsFor: collection items ]
 							].
-					writer nextPut: resource
+					aResourceWritingBlock value: writer value: resource
 					]
 			]
 ]

source/Stargate-Model/ResourceLocator.class.st

@@ -41,6 +41,12 @@ ResourceLocator class >> handling: aStringOrSymbol resolvingLocationWith: aLocat
 		andIdentifierBy: aBlock
 ]
 
+{ #category : #accessing }
+ResourceLocator >> baseUrl [
+
+	^ baseUrl
+]
+
 { #category : #accessing }
 ResourceLocator >> baseUrl: aServerUrl [
 
@@ -59,12 +65,24 @@ ResourceLocator >> endpoint [
 	^ endpoint
 ]
 
+{ #category : #private }
+ResourceLocator >> exceptionHandler [
+
+	^ exceptionHandler
+]
+
 { #category : #accessing }
 ResourceLocator >> handleExceptionsWith: anExceptionHandler [
 
 	exceptionHandler := anExceptionHandler
 ]
 
+{ #category : #private }
+ResourceLocator >> identifierLookupAction [
+
+	^ identifierLookupAction
+]
+
 { #category : #initialization }
 ResourceLocator >> initializeHandling: aStringOrSymbol resolvingLocationWith: aLocationResolverBinding andIdentifierBy: aBlock [
 
@@ -78,17 +96,6 @@ ResourceLocator >> initializeHandling: aStringOrSymbol resolvingLocationWith: aL
 { #category : #querying }
 ResourceLocator >> locationOf: resource within: requestContext [
 
-	^ baseUrl / endpoint asUrl
+	^ self baseUrl / endpoint asUrl
 		/ ( locationResolverBinding content cull: resource cull: requestContext ) asString asUrl
 ]
-
-{ #category : #querying }
-ResourceLocator >> lookupResouceIdentifiedBy: httpRequest evaluating: aQueryBlock [
-
-	^ exceptionHandler
-		handleNotFoundAndMissingParametersDuring: [ 
-			| identifier |
-			identifier := identifierLookupAction cull: httpRequest.
-			aQueryBlock cull: identifier
-			]
-]