From 7dc4359501b45c5d913f6a54edcd48de805c4ade Mon Sep 17 00:00:00 2001 From: Gabriel Omar Cotelli Date: Wed, 17 Oct 2018 17:55:21 -0300 Subject: [PATCH 1/4] Add GET empty pets test Still missing encoding rules --- .../PetsRESTfulWebService.class.st | 12 +++- ...etsRESTfulWebServiceSpecification.class.st | 18 +++++- .../PetsRESTfulWebServiceTest.class.st | 58 +++++++++++++++++-- .../RESTfulWebService.class.st | 21 +++++++ 4 files changed, 101 insertions(+), 8 deletions(-) diff --git a/source/Stargate-Examples/PetsRESTfulWebService.class.st b/source/Stargate-Examples/PetsRESTfulWebService.class.st index 7c2369a..c057d6c 100644 --- a/source/Stargate-Examples/PetsRESTfulWebService.class.st +++ b/source/Stargate-Examples/PetsRESTfulWebService.class.st @@ -43,6 +43,16 @@ PetsRESTfulWebService >> getPetBasedOn: anHttpRequest within: aContext [ within: aContext ] +{ #category : #API } +PetsRESTfulWebService >> getPetsBasedOn: anHttpRequest within: aContext [ + + ^ self + get: [ self pets ] + asCollectionEncodedUsing: self specification petsMappingKey + basedOn: anHttpRequest + within: aContext +] + { #category : #initialization } PetsRESTfulWebService >> initialize [ @@ -89,7 +99,7 @@ PetsRESTfulWebService >> updatePetStatusBasedOn: anHttpRequest within: aContext resource := self decode: anHttpRequest contents - at: #pets + at: self specification petMappingKey from: anHttpRequest contentType within: aContext. pet := self petIdentifiedUsing: anHttpRequest. diff --git a/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st b/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st index da1efda..e4c698b 100644 --- a/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st +++ b/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st @@ -30,7 +30,15 @@ PetsRESTfulWebServiceSpecification >> addJsonEncoderVersion1dot0dot0MappingIn: a streamContents: [ :stream | (HypermediaAwareJSONWriter on: stream) mediaControls: (context objectUnder: #mediaControls ifNone: [ #() ]) asDictionary; - nextPut: {('name' -> pet name)} asDictionary ] ] + nextPut: {('name' -> pet name)} asDictionary ] ]; + addDefaultRuleToEncode: self petsMappingKey + to: self petSummaryVersion1dot0dot0MediaType + using: [ :pets :context | + String + streamContents: [ :stream | + (HypermediaAwareJSONWriter on: stream) + mediaControls: (context objectUnder: #mediaControls ifNone: [ #() ]) asDictionary; + nextPut: {('items' -> pets)} asDictionary ] ] ] { #category : #routes } @@ -78,7 +86,7 @@ PetsRESTfulWebServiceSpecification >> identifierKey [ { #category : #accessing } PetsRESTfulWebServiceSpecification >> petMappingKey [ - ^ #pets + ^ #pet ] { #category : #'accessing - media types' } @@ -93,6 +101,12 @@ PetsRESTfulWebServiceSpecification >> petVersion1dot0dot0MediaType [ ^ 'application/vnd.stargate.pet+json;version=1.0.0' asZnMimeType ] +{ #category : #accessing } +PetsRESTfulWebServiceSpecification >> petsMappingKey [ + + ^ #pets +] + { #category : #routes } PetsRESTfulWebServiceSpecification >> updatePetRoute [ diff --git a/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st b/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st index dbd3ef0..7a0b875 100644 --- a/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st +++ b/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st @@ -7,10 +7,22 @@ Class { #category : #'Stargate-REST-API-Tests' } +{ #category : #'private - support' } +PetsRESTfulWebServiceTest >> baseUrl [ + + ^ 'https://pets.example.com' asZnUrl +] + +{ #category : #'private - support' } +PetsRESTfulWebServiceTest >> petsUrl [ + + ^ self baseUrl / '/pets/' asZnUrl +] + { #category : #'private - support' } PetsRESTfulWebServiceTest >> requestToCreatePetFrom: aJson [ - ^ (ZnRequest post: 'http://BASE_URL/pets') + ^ (ZnRequest post: self petsUrl) entity: (ZnEntity with: aJson type: webService specification petVersion1dot0dot0MediaType); yourself ] @@ -18,7 +30,7 @@ PetsRESTfulWebServiceTest >> requestToCreatePetFrom: aJson [ { #category : #'private - support' } PetsRESTfulWebServiceTest >> requestToDeletePetIdentifiedBy: anIdentifier [ - ^ TeaRequest fromZnRequest: (ZnRequest delete: ('http://BASE_URL/pets/<1p>' expandMacrosWith: anIdentifier)) pathParams: {(#identifier -> anIdentifier)} asDictionary + ^ TeaRequest fromZnRequest: (ZnRequest delete: (self urlForPetIdentifiedBy: anIdentifier)) pathParams: {(#identifier -> anIdentifier)} asDictionary ] { #category : #'private - support' } @@ -26,18 +38,26 @@ PetsRESTfulWebServiceTest >> requestToGetPetIdentifiedBy: anIdentifier accepting ^ TeaRequest fromZnRequest: - ((ZnRequest get: ('http://BASE_URL/pets/<1p>' expandMacrosWith: anIdentifier)) + ((ZnRequest get: (self urlForPetIdentifiedBy: anIdentifier)) setAccept: anAcceptHeader; yourself) pathParams: {(#identifier -> anIdentifier)} asDictionary ] +{ #category : #'private - support' } +PetsRESTfulWebServiceTest >> requestToGetPetsAccepting: anAcceptHeader [ + + ^ (ZnRequest get: self petsUrl) + setAccept: anAcceptHeader; + yourself +] + { #category : #'private - support' } PetsRESTfulWebServiceTest >> requestToUpdatePetIdentifiedBy: anIdentifier statusTo: aStatus [ ^ TeaRequest fromZnRequest: - ((ZnRequest patch: ('http://BASE_URL/pets/<1p>' expandMacrosWith: anIdentifier)) + ((ZnRequest patch: (self urlForPetIdentifiedBy: anIdentifier)) entity: (ZnEntity with: ('{"status":"<1s>"}' expandMacrosWith: aStatus) type: webService specification petVersion1dot0dot0MediaType); yourself) pathParams: {(#identifier -> anIdentifier)} asDictionary @@ -47,7 +67,7 @@ PetsRESTfulWebServiceTest >> requestToUpdatePetIdentifiedBy: anIdentifier status PetsRESTfulWebServiceTest >> setUp [ webService := PetsRESTfulWebService new. - webService serverUrl: 'https://pets.example.com' asZnUrl + webService serverUrl: self baseUrl asZnUrl ] { #category : #tests } @@ -143,6 +163,28 @@ PetsRESTfulWebServiceTest >> testGetPetSummaryJustCreated [ assert: json type isNil ] ] +{ #category : #tests } +PetsRESTfulWebServiceTest >> testGetPets [ + + | response | + + self assert: webService pets isEmpty. + + response := webService getPetsBasedOn: (self requestToGetPetsAccepting: '*/*') within: HttpRequestContext new. + + self + assert: response isSuccess; + assert: response status equals: 200; + assert: response contentType asZnMimeType equals: webService specification petSummaryVersion1dot0dot0MediaType. + + self + withJsonFromContentsIn: response + do: [ :json | + self + assert: json items isEmpty; + assert: json links self equals: 'https://pets.example.com/pets/' ] +] + { #category : #tests } PetsRESTfulWebServiceTest >> testPetCreation [ @@ -194,6 +236,12 @@ PetsRESTfulWebServiceTest >> testUpdatePetStatus [ assert: json links self equals: 'https://pets.example.com/pets/1' ] ] +{ #category : #'private - support' } +PetsRESTfulWebServiceTest >> urlForPetIdentifiedBy: anIdentifier [ + + ^ self petsUrl / anIdentifier printString asZnUrl +] + { #category : #'private - support' } PetsRESTfulWebServiceTest >> withJsonFromContentsIn: httpResponse do: aBlock [ diff --git a/source/Stargate-REST-API/RESTfulWebService.class.st b/source/Stargate-REST-API/RESTfulWebService.class.st index 1093167..d2a166f 100644 --- a/source/Stargate-REST-API/RESTfulWebService.class.st +++ b/source/Stargate-REST-API/RESTfulWebService.class.st @@ -49,6 +49,27 @@ RESTfulWebService >> evaluateQuery: aQueryEvaluationBlock [ do: [ :signal | HTTPClientError signalNotFound: signal messageText ] ] +{ #category : #'private - API' } +RESTfulWebService >> get: aQueryEvaluationBlock asCollectionEncodedUsing: aKey basedOn: anHttpRequest within: aContext [ + + | mediaType result | + + mediaType := self targetMediaTypeFrom: anHttpRequest. + + ^ [ | encodedResult | + + result := self evaluateQuery: aQueryEvaluationBlock. + aContext hold: {('self' -> anHttpRequest absoluteUrl printString)} under: #mediaControls. + encodedResult := self + encode: result + at: aKey + to: mediaType + within: aContext. + ZnResponse ok: encodedResult ] + on: ConflictingObjectFound + do: [ :error | HTTPClientError signalConflict: error messageText ] +] + { #category : #'private - API' } RESTfulWebService >> get: aQueryEvaluationBlock encodedUsing: aKey basedOn: anHttpRequest within: aContext [ From f8b3a115de294fdebf5392ea07326e762ab63fe3 Mon Sep 17 00:00:00 2001 From: Gabriel Omar Cotelli Date: Wed, 17 Oct 2018 18:00:41 -0300 Subject: [PATCH 2/4] Add collection test. Still failing. --- .../PetsRESTfulWebServiceTest.class.st | 33 +++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st b/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st index 7a0b875..d2217f8 100644 --- a/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st +++ b/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st @@ -185,6 +185,39 @@ PetsRESTfulWebServiceTest >> testGetPets [ assert: json links self equals: 'https://pets.example.com/pets/' ] ] +{ #category : #tests } +PetsRESTfulWebServiceTest >> testGetPetsNotEmpty [ + + | response | + + self assert: webService pets isEmpty. + + webService createPetBasedOn: (self requestToCreatePetFrom: '{"name":"Firulais","type":"dog"}') within: HttpRequestContext new. + + self assert: webService pets notEmpty. + + response := webService getPetsBasedOn: (self requestToGetPetsAccepting: '*/*') within: HttpRequestContext new. + + self + assert: response isSuccess; + assert: response status equals: 200; + assert: response contentType asZnMimeType equals: webService specification petSummaryVersion1dot0dot0MediaType. + + self + withJsonFromContentsIn: response + do: [ :json | + | dogSummary | + + self + assert: json links self equals: 'https://pets.example.com/pets/'; + assert: json items size equals: 1. + dogSummary := json items first. + self + assert: dogSummary name equals: 'Firulais'; + assert: dogSummary links self equals: 'https://pets.example.com/pets/1'; + assert: dogSummary type isNil ] +] + { #category : #tests } PetsRESTfulWebServiceTest >> testPetCreation [ From dcd3acb098f594b69736a4f364cd3553332db465 Mon Sep 17 00:00:00 2001 From: Gabriel Omar Cotelli Date: Thu, 18 Oct 2018 11:07:40 -0300 Subject: [PATCH 3/4] Get collection test working --- source/Stargate-Examples/Pet.class.st | 56 +++++++++++++++++++ .../PetsRESTfulWebService.class.st | 18 ++++-- ...etsRESTfulWebServiceSpecification.class.st | 39 ++++++++++--- .../PetsRESTfulWebServiceTest.class.st | 45 ++++++++++++++- .../HypermediaAwareJSONWriter.class.st | 36 ------------ .../RESTfulWebService.class.st | 28 +++++++--- 6 files changed, 162 insertions(+), 60 deletions(-) create mode 100644 source/Stargate-Examples/Pet.class.st delete mode 100644 source/Stargate-REST-API/HypermediaAwareJSONWriter.class.st diff --git a/source/Stargate-Examples/Pet.class.st b/source/Stargate-Examples/Pet.class.st new file mode 100644 index 0000000..2f81704 --- /dev/null +++ b/source/Stargate-Examples/Pet.class.st @@ -0,0 +1,56 @@ +" +I'm a toy abstraction used just as an example +" +Class { + #name : #Pet, + #superclass : #Object, + #instVars : [ + 'name', + 'type', + 'status' + ], + #category : #'Stargate-Examples' +} + +{ #category : #'instance creation' } +Pet class >> named: aName ofType: aPetType [ + + ^ self named: aName ofType: aPetType withStatus: 'new' +] + +{ #category : #'instance creation' } +Pet class >> named: aName ofType: aPetType withStatus: status [ + + ^ self new initializeNamed: aName ofType: aPetType withStatus: status +] + +{ #category : #initialization } +Pet >> initializeNamed: aName ofType: aPetType withStatus: aStatus [ + + name := aName. + type := aPetType. + status := aStatus +] + +{ #category : #accessing } +Pet >> name [ + ^ name +] + +{ #category : #accessing } +Pet >> status [ + ^ status +] + +{ #category : #updating } +Pet >> synchronizeWith: aPet [ + + name := aPet name. + type := aPet type. + status := aPet status +] + +{ #category : #accessing } +Pet >> type [ + ^ type +] diff --git a/source/Stargate-Examples/PetsRESTfulWebService.class.st b/source/Stargate-Examples/PetsRESTfulWebService.class.st index c057d6c..50e19ba 100644 --- a/source/Stargate-Examples/PetsRESTfulWebService.class.st +++ b/source/Stargate-Examples/PetsRESTfulWebService.class.st @@ -1,3 +1,6 @@ +" +I'm an example RESTful Web Service implementing Pet resource management +" Class { #name : #PetsRESTfulWebService, #superclass : #RESTfulWebService, @@ -13,11 +16,14 @@ Class { PetsRESTfulWebService >> createPetBasedOn: anHttpRequest within: aContext [ ^ self - withCreatedResourceDo: [ :pet | - pets add: pet. - pet at: #status put: 'new'. - petById at: nextId put: pet. - nextId := nextId + 1 ] + withCreatedResourceDo: [ :resource | + | newPet | + + newPet := Pet named: resource name ofType: resource type. + pets add: newPet. + petById at: nextId put: newPet. + nextId := nextId + 1. + newPet ] decodedUsing: self specification petMappingKey basedOn: anHttpRequest within: aContext @@ -103,7 +109,7 @@ PetsRESTfulWebService >> updatePetStatusBasedOn: anHttpRequest within: aContext from: anHttpRequest contentType within: aContext. pet := self petIdentifiedUsing: anHttpRequest. - pet at: #status put: (resource at: #status). + pet synchronizeWith: (Pet named: (resource at: #name ifAbsent: [ pet name ]) ofType: (resource at: #type ifAbsent: [ pet type ]) withStatus: (resource at: #status ifAbsent: [ pet status ])). pet ] encodedUsing: self specification petMappingKey basedOn: anHttpRequest diff --git a/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st b/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st index e4c698b..d1422ea 100644 --- a/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st +++ b/source/Stargate-Examples/PetsRESTfulWebServiceSpecification.class.st @@ -20,25 +20,42 @@ PetsRESTfulWebServiceSpecification >> addJsonEncoderVersion1dot0dot0MappingIn: a using: [ :pet :context | String streamContents: [ :stream | - (HypermediaAwareJSONWriter on: stream) - mediaControls: (context objectUnder: #mediaControls ifNone: [ #() ]) asDictionary; + (NeoJSONWriter on: stream) + for: Pet + do: [ :mapping | + mapping + mapInstVars; + mapProperty: #links getter: [ :thePet | (self mediaControlsIn: context) asDictionary ] setter: [ :object :value | ] ]; nextPut: pet ] ]; addRuleToEncode: self petMappingKey to: self petSummaryVersion1dot0dot0MediaType using: [ :pet :context | String streamContents: [ :stream | - (HypermediaAwareJSONWriter on: stream) - mediaControls: (context objectUnder: #mediaControls ifNone: [ #() ]) asDictionary; - nextPut: {('name' -> pet name)} asDictionary ] ]; + (NeoJSONWriter on: stream) + for: Pet + do: [ :mapping | + mapping + mapInstVar: #name; + mapProperty: #links getter: [ :thePet | (self mediaControlsIn: context) asDictionary ] setter: [ :object :value | ] ]; + nextPut: pet ] ]; addDefaultRuleToEncode: self petsMappingKey to: self petSummaryVersion1dot0dot0MediaType using: [ :pets :context | String streamContents: [ :stream | - (HypermediaAwareJSONWriter on: stream) - mediaControls: (context objectUnder: #mediaControls ifNone: [ #() ]) asDictionary; - nextPut: {('items' -> pets)} asDictionary ] ] + | 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 | ] ]; + nextPut: + {('items' -> pets). + ('links' -> (self mediaControlsIn: context) asDictionary)} asDictionary ] ] ] { #category : #routes } @@ -83,6 +100,12 @@ PetsRESTfulWebServiceSpecification >> identifierKey [ ^ #identifier ] +{ #category : #'mapping rules' } +PetsRESTfulWebServiceSpecification >> mediaControlsIn: context [ + + ^ context objectUnder: #mediaControls ifNone: [ #() ] +] + { #category : #accessing } PetsRESTfulWebServiceSpecification >> petMappingKey [ diff --git a/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st b/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st index d2217f8..5449ef9 100644 --- a/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st +++ b/source/Stargate-REST-API-Tests/PetsRESTfulWebServiceTest.class.st @@ -52,6 +52,17 @@ PetsRESTfulWebServiceTest >> requestToGetPetsAccepting: anAcceptHeader [ yourself ] +{ #category : #'private - support' } +PetsRESTfulWebServiceTest >> requestToUpdatePetIdentifiedBy: anIdentifier nameTo: aName [ + + ^ TeaRequest + fromZnRequest: + ((ZnRequest patch: (self urlForPetIdentifiedBy: anIdentifier)) + entity: (ZnEntity with: ('{"name":"<1s>"}' expandMacrosWith: aName) type: webService specification petVersion1dot0dot0MediaType); + yourself) + pathParams: {(#identifier -> anIdentifier)} asDictionary +] + { #category : #'private - support' } PetsRESTfulWebServiceTest >> requestToUpdatePetIdentifiedBy: anIdentifier statusTo: aStatus [ @@ -160,7 +171,8 @@ PetsRESTfulWebServiceTest >> testGetPetSummaryJustCreated [ self assert: json name equals: 'Firulais'; assert: json links self equals: 'https://pets.example.com/pets/1'; - assert: json type isNil ] + assert: json type isNil; + assert: json status isNil ] ] { #category : #tests } @@ -236,6 +248,37 @@ PetsRESTfulWebServiceTest >> testPetCreation [ assert: webService pets first name equals: 'Firulais' ] +{ #category : #tests } +PetsRESTfulWebServiceTest >> testUpdatePetName [ + + | response | + + self assert: webService pets isEmpty. + + self assert: (webService createPetBasedOn: (self requestToCreatePetFrom: '{"name":"Firulais","type":"dog"}') within: HttpRequestContext new) isSuccess. + + self assert: webService pets first name equals: 'Firulais'. + + response := webService updatePetStatusBasedOn: (self requestToUpdatePetIdentifiedBy: 1 nameTo: 'Mendieta') within: HttpRequestContext new. + + self + assert: response isSuccess; + assert: response status equals: 200; + assert: response hasEntity; + assert: webService pets size equals: 1; + assert: webService pets first name equals: 'Mendieta'; + assert: webService pets first status equals: 'new'. + + self + withJsonFromContentsIn: response + do: [ :json | + self + assert: json name equals: 'Mendieta'; + assert: json type equals: 'dog'; + assert: json status equals: 'new'; + assert: json links self equals: 'https://pets.example.com/pets/1' ] +] + { #category : #tests } PetsRESTfulWebServiceTest >> testUpdatePetStatus [ diff --git a/source/Stargate-REST-API/HypermediaAwareJSONWriter.class.st b/source/Stargate-REST-API/HypermediaAwareJSONWriter.class.st deleted file mode 100644 index fe90cf2..0000000 --- a/source/Stargate-REST-API/HypermediaAwareJSONWriter.class.st +++ /dev/null @@ -1,36 +0,0 @@ -Class { - #name : #HypermediaAwareJSONWriter, - #superclass : #NeoJSONWriter, - #instVars : [ - 'mediaControls' - ], - #category : #'Stargate-REST-API' -} - -{ #category : #'initialize-release' } -HypermediaAwareJSONWriter >> initialize [ - - super initialize. - mediaControls := Dictionary new -] - -{ #category : #'initialize-release' } -HypermediaAwareJSONWriter >> mediaControls: aDictionary [ - - mediaControls := aDictionary -] - -{ #category : #writing } -HypermediaAwareJSONWriter >> writeMapStreamingDo: block [ - - | controls | - - writeStream nextPut: ${. - controls := mediaControls. - mediaControls := Dictionary new. - self writeStreamingDo: block. - controls - ifNotEmpty: [ self mapElementSeparator. - self encodeKey: 'links' value: controls ]. - writeStream nextPut: $} -] diff --git a/source/Stargate-REST-API/RESTfulWebService.class.st b/source/Stargate-REST-API/RESTfulWebService.class.st index d2a166f..407461d 100644 --- a/source/Stargate-REST-API/RESTfulWebService.class.st +++ b/source/Stargate-REST-API/RESTfulWebService.class.st @@ -52,16 +52,20 @@ RESTfulWebService >> evaluateQuery: aQueryEvaluationBlock [ { #category : #'private - API' } RESTfulWebService >> get: aQueryEvaluationBlock asCollectionEncodedUsing: aKey basedOn: anHttpRequest within: aContext [ - | mediaType result | + | mediaType collection | mediaType := self targetMediaTypeFrom: anHttpRequest. - ^ [ | encodedResult | + ^ [ | encodedResult individualMediaControls | - result := self evaluateQuery: aQueryEvaluationBlock. - aContext hold: {('self' -> anHttpRequest absoluteUrl printString)} under: #mediaControls. + 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: result + encode: collection at: aKey to: mediaType within: aContext. @@ -80,7 +84,7 @@ RESTfulWebService >> get: aQueryEvaluationBlock encodedUsing: aKey basedOn: anHt ^ [ | encodedResult | result := self evaluateQuery: aQueryEvaluationBlock. - aContext hold: {('self' -> (self locationOf: result))} under: #mediaControls. + aContext hold: (self mediaControlsFor: result) under: #mediaControls. encodedResult := self encode: result at: aKey @@ -105,6 +109,12 @@ RESTfulWebService >> locationOf: resource [ self subclassResponsibility ] +{ #category : #'private - accessing' } +RESTfulWebService >> mediaControlsFor: result [ + + ^ {('self' -> (self locationOf: result))} +] + { #category : #configuring } RESTfulWebService >> serverUrl: aServerUrl [ @@ -131,7 +141,7 @@ RESTfulWebService >> targetMediaTypeFrom: anHttpRequest [ { #category : #'private - API' } RESTfulWebService >> withCreatedResourceDo: aBlock decodedUsing: aKey basedOn: anHttpRequest within: aContext [ - | resource | + | resource newObject | resource := self decode: anHttpRequest contents @@ -139,9 +149,9 @@ RESTfulWebService >> withCreatedResourceDo: aBlock decodedUsing: aKey basedOn: a from: anHttpRequest contentType within: aContext. - [ aBlock value: resource ] + newObject := [ aBlock value: resource ] on: ConflictingObjectFound do: [ :signal | HTTPClientError signalConflict: signal messageText ]. - ^ ZnResponse created: (self locationOf: resource) + ^ ZnResponse created: (self locationOf: newObject) ] From 6328f6677bea94bdc5592485bc153134c49e0e21 Mon Sep 17 00:00:00 2001 From: Gabriel Omar Cotelli Date: Thu, 18 Oct 2018 12:09:30 -0300 Subject: [PATCH 4/4] Improved hypermedia control management --- ...etsRESTfulWebServiceSpecification.class.st | 17 ++----- .../HttpRequestContext.class.st | 39 +++++++++++++++- .../NeoJSONObjectMapping.extension.st | 13 ++++++ .../RESTfulWebService.class.st | 45 ++++++++----------- 4 files changed, 73 insertions(+), 41 deletions(-) create mode 100644 source/Stargate-REST-API/NeoJSONObjectMapping.extension.st 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) ]