diff --git a/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st b/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st index d1422ea..96dc4c3 100644 --- a/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st +++ b/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 [ diff --git a/source/Stargate-REST-API/HttpRequestContext.class.st b/source/Stargate-REST-API/HttpRequestContext.class.st index 8df3219..f6ca85c 100644 --- a/source/Stargate-REST-API/HttpRequestContext.class.st +++ b/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 } diff --git a/source/Stargate-REST-API/NeoJSONObjectMapping.extension.st b/source/Stargate-REST-API/NeoJSONObjectMapping.extension.st new file mode 100644 index 0000000..2f3ac99 --- /dev/null +++ b/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 ] +] diff --git a/source/Stargate-REST-API/RESTfulWebService.class.st b/source/Stargate-REST-API/RESTfulWebService.class.st index 407461d..1f6c0f1 100644 --- a/source/Stargate-REST-API/RESTfulWebService.class.st +++ b/source/Stargate-REST-API/RESTfulWebService.class.st @@ -52,24 +52,23 @@ 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 ] ] @@ -77,20 +76,14 @@ RESTfulWebService >> get: aQueryEvaluationBlock asCollectionEncodedUsing: aKey b { #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) ]