Merge pull request #194 from ba-st/hypermedia_refactor

Refactor hypermedia support to allow library users to use a different…
ba-st · Jun 15, 2024 · cab16c7 · cab16c7
2 parents 22860d4 + 3249be3
commit cab16c7
Show file tree

Hide file tree

Showing 5 changed files with 140 additions and 86 deletions.
diff --git a/source/Stargate-Examples/SouthAmericanCurrenciesRESTfulController.class.st b/source/Stargate-Examples/SouthAmericanCurrenciesRESTfulController.class.st
@@ -137,15 +137,22 @@ SouthAmericanCurrenciesRESTfulController >> initializeBanknotesByCurrency [
 { #category : 'initialization' }
 SouthAmericanCurrenciesRESTfulController >> initializeBanknotesRequestHandler [
 
-	banknotesRequestHandler := RESTfulRequestHandlerBuilder new
-		handling: 'banknotes'
-			extractingIdentifierWith: [ :httpRequest | self identifierIn: httpRequest ]
-			locatingParentResourceWith: currenciesRequestHandler resourceLocator;
-		whenResponding: ZnMimeType applicationJson
-			encodeToJsonApplying: [ :resource :requestContext :writer |  ];
-		createEntityTagHashing: [ :hasher :banknote :requestContext | hasher include: banknote ];
-		directCachingWith: [ :caching | caching doNotExpire ];
-		build
+  banknotesRequestHandler := RESTfulRequestHandlerBuilder new
+                               handling: 'banknotes'
+                               extractingIdentifierWith: [ :httpRequest |
+                                   self identifierIn: httpRequest ]
+                               locatingParentResourceWith: currenciesRequestHandler resourceLocator;
+                               whenResponding: ZnMimeType applicationJson
+                               encodeToJsonApplying: [ :resource :requestContext :writer |
+                                   writer
+                                     for: #Banknotes
+                                     customDo: [ :mapping |
+                                         mapping encoder: [ :banknotes | banknotes ] ] ]
+                               as: #Banknotes;
+                               createEntityTagHashing: [ :hasher :banknote :requestContext |
+                                   hasher include: banknote ];
+                               directCachingWith: [ :caching | caching doNotExpire ];
+                               build
 ]
 
 { #category : 'initialization' }

diff --git a/source/Stargate-Model/HypermediaDrivenRESTfulRequestHandler.class.st b/source/Stargate-Model/HypermediaDrivenRESTfulRequestHandler.class.st
@@ -12,6 +12,35 @@ Class {
 	#tag : 'HATEOAS'
 }
 
+{ #category : 'encoding' }
+HypermediaDrivenRESTfulRequestHandler class >> encode: resource toJsonUsing: writer as: schema within: requestContext [
+
+  writer
+    for: ResourceCollection do: [ :mapping |
+        ( mapping mapInstVar: #items ) valueSchema: #ResourceCollectionItems.
+        mapping mapAsHypermediaControls: [ :collection |
+              requestContext hypermediaControlsFor: collection items ]
+      ];
+    for: #ResourceCollectionItems customDo: [ :mapping | mapping listOfElementSchema: schema ].
+
+  [ writer nextPut: resource as: schema ]
+    unless: ( resource isA: ResourceCollection )
+    inWhichCase: [ writer nextPut: resource ]
+]
+
+{ #category : 'encoding' }
+HypermediaDrivenRESTfulRequestHandler class >> encode: resource toJsonUsing: writer within: requestContext [
+
+  writer for: ResourceCollection do: [ :mapping |
+      mapping
+        mapInstVar: #items;
+        mapAsHypermediaControls: [ :collection |
+            requestContext hypermediaControlsFor: collection items ]
+    ].
+
+  writer nextPut: resource
+]
+
 { #category : 'instance creation' }
 HypermediaDrivenRESTfulRequestHandler class >> resourceLocator: aResouceLocator paginationPolicy: aPaginationPolicy decodingRules: theDecodingRules encodingRules: theEncodingRules calculateEntityTagsWith: entityTagCalculator cachingDirectives: theCachingDirectives allowedLanguageTags: allowedLanguageTags drivenBy: aMediaControlsFactory handleErrorsWith: anExceptionHandler [
 

diff --git a/source/Stargate-Model/RESTfulRequestHandler.class.st b/source/Stargate-Model/RESTfulRequestHandler.class.st
@@ -10,6 +10,18 @@ Class {
 	#tag : 'Controllers'
 }
 
+{ #category : 'encoding' }
+RESTfulRequestHandler class >> encode: resource toJsonUsing: writer as: schema within: requestContext [
+
+  writer nextPut: resource as: schema
+]
+
+{ #category : 'encoding' }
+RESTfulRequestHandler class >> encode: resource toJsonUsing: writer within: requestContext [
+
+  writer nextPut: resource
+]
+
 { #category : 'instance creation' }
 RESTfulRequestHandler class >> resourceLocator: aResouceLocator paginationPolicy: aPaginationPolicy decodingRules: theDecodingRules encodingRules: theEncodingRules calculateEntityTagsWith: entityTagCalculator cachingDirectives: theCachingDirectives allowedLanguageTags: allowedLanguageTags handleErrorsWith: anExceptionHandler [
 

diff --git a/source/Stargate-Model/RESTfulRequestHandlerBehavior.class.st b/source/Stargate-Model/RESTfulRequestHandlerBehavior.class.st
@@ -19,6 +19,18 @@ Class {
 	#tag : 'Controllers'
 }
 
+{ #category : 'encoding' }
+RESTfulRequestHandlerBehavior class >> encode: resource toJsonUsing: writer as: schema within: requestContext [
+
+  self subclassResponsibility
+]
+
+{ #category : 'encoding' }
+RESTfulRequestHandlerBehavior class >> encode: resource toJsonUsing: writer within: requestContext [
+
+  self subclassResponsibility
+]
+
 { #category : 'private' }
 RESTfulRequestHandlerBehavior >> applyCachingDirectivesFor: aResource to: response within: requestContext [
 

diff --git a/source/Stargate-Model/RESTfulRequestHandlerBuilder.class.st b/source/Stargate-Model/RESTfulRequestHandlerBuilder.class.st
@@ -9,11 +9,12 @@ Class {
 		'encodingRules',
 		'paginationPolicyFactory',
 		'entityTagFactoryBinding',
-		'handlerFactory',
 		'resourceLocator',
 		'exceptionHandler',
 		'cachingDirectives',
-		'allowedLanguageTags'
+		'allowedLanguageTags',
+		'requestHandlerClass',
+		'requestHandlerFactory'
 	],
 	#category : 'Stargate-Model-Controllers',
 	#package : 'Stargate-Model',
@@ -35,34 +36,37 @@ RESTfulRequestHandlerBuilder >> beHypermediaDriven [
 { #category : 'configuring' }
 RESTfulRequestHandlerBuilder >> beHypermediaDrivenBy: aMediaControlsFactoryBlock [
 
-	AssertionChecker
-		enforce: [ resourceLocator canLookupResources ]
-		because: 'Missing location resolution.'.
-	handlerFactory := [ HypermediaDrivenRESTfulRequestHandler
-		resourceLocator: resourceLocator
-		paginationPolicy: paginationPolicyFactory
-		decodingRules: decodingRules
-		encodingRules: encodingRules
-		calculateEntityTagsWith: entityTagFactoryBinding content
-		cachingDirectives: cachingDirectives
-		allowedLanguageTags: allowedLanguageTags
-		drivenBy: [ :builder :resource :requestContext :resourceLocation | 
-			builder addAsSelfLink: resourceLocation.
-			aMediaControlsFactoryBlock
-				cull: builder
-				cull: resource
-				cull: requestContext
-				cull: resourceLocation.
-			builder build
-			]
-		handleErrorsWith: exceptionHandler
-	]
+  AssertionChecker
+    enforce: [ resourceLocator canLookupResources ] because: 'Missing location resolution.';
+    enforce: [ encodingRules isEmpty ]
+    because: 'Encoding rules needs to be configured after hypermedia'.
+  requestHandlerClass := HypermediaDrivenRESTfulRequestHandler.
+  requestHandlerFactory := [
+                             requestHandlerClass
+                               resourceLocator: resourceLocator
+                               paginationPolicy: paginationPolicyFactory
+                               decodingRules: decodingRules
+                               encodingRules: encodingRules
+                               calculateEntityTagsWith: entityTagFactoryBinding content
+                               cachingDirectives: cachingDirectives
+                               allowedLanguageTags: allowedLanguageTags
+                               drivenBy: [ :builder :resource :requestContext :resourceLocation |
+                                   builder addAsSelfLink: resourceLocation.
+                                   aMediaControlsFactoryBlock
+                                     cull: builder
+                                     cull: resource
+                                     cull: requestContext
+                                     cull: resourceLocation.
+                                   builder build
+                                 ]
+                               handleErrorsWith: exceptionHandler
+                           ]
 ]
 
 { #category : 'building' }
 RESTfulRequestHandlerBuilder >> build [
 
-	^  handlerFactory value
+	^  requestHandlerFactory value
 ]
 
 { #category : 'configuring' }
@@ -159,24 +163,27 @@ RESTfulRequestHandlerBuilder >> handling: anEndpoint locatingSubresourcesWith: a
 { #category : 'initialization' }
 RESTfulRequestHandlerBuilder >> initialize [
 
-	super initialize.
-	decodingRules := Dictionary new.
-	encodingRules := Dictionary new.
-	entityTagFactoryBinding := Binding undefinedExplainedBy: 'Missing ETag calculation'.
-	cachingDirectives := #().
-	allowedLanguageTags := OrderedCollection new.
-	paginationPolicyFactory := [ :requestHandler | RESTfulControllerDoNotPaginateCollectionsPolicy for: requestHandler ].
-	exceptionHandler := RESTfulRequestExceptionHandler new.
-	handlerFactory := [ RESTfulRequestHandler
-		resourceLocator: resourceLocator
-		paginationPolicy: paginationPolicyFactory
-		decodingRules: decodingRules
-		encodingRules: encodingRules
-		calculateEntityTagsWith: entityTagFactoryBinding content
-		cachingDirectives: cachingDirectives
-		allowedLanguageTags: allowedLanguageTags
-		handleErrorsWith: exceptionHandler
-	]
+  super initialize.
+  decodingRules := Dictionary new.
+  encodingRules := Dictionary new.
+  entityTagFactoryBinding := Binding undefinedExplainedBy: 'Missing ETag calculation'.
+  cachingDirectives := #(  ).
+  allowedLanguageTags := OrderedCollection new.
+  paginationPolicyFactory := [ :requestHandler |
+                               RESTfulControllerDoNotPaginateCollectionsPolicy for: requestHandler ].
+  exceptionHandler := RESTfulRequestExceptionHandler new.
+  requestHandlerClass := RESTfulRequestHandler.
+  requestHandlerFactory := [
+                             requestHandlerClass
+                               resourceLocator: resourceLocator
+                               paginationPolicy: paginationPolicyFactory
+                               decodingRules: decodingRules
+                               encodingRules: encodingRules
+                               calculateEntityTagsWith: entityTagFactoryBinding content
+                               cachingDirectives: cachingDirectives
+                               allowedLanguageTags: allowedLanguageTags
+                               handleErrorsWith: exceptionHandler
+                           ]
 ]
 
 { #category : 'private' }
@@ -227,43 +234,30 @@ RESTfulRequestHandlerBuilder >> whenResponding: aMediaType encodeApplying: anEnc
 { #category : 'encoding' }
 RESTfulRequestHandlerBuilder >> whenResponding: aMediaType encodeToJsonApplying: aBlock [
 
-	self whenResponding: aMediaType encodeApplying: [ :resource :requestContext | 
-		self
-			jsonFor: resource
-			within: requestContext
-			applying: aBlock
-			writingResourceWith: [ :writer | 
-				writer for: ResourceCollection do: [ :mapping | 
-					mapping
-						mapInstVar: #items;
-						mapAsHypermediaControls: [ :collection | 
-							requestContext hypermediaControlsFor: collection items ]
-					].
-				writer nextPut: resource
-				]
-		]
+  self whenResponding: aMediaType encodeApplying: [ :resource :requestContext |
+      self
+        jsonFor: resource
+        within: requestContext
+        applying: aBlock
+        writingResourceWith: [ :writer |
+          requestHandlerClass encode: resource toJsonUsing: writer within: requestContext ]
+    ]
 ]
 
 { #category : 'encoding' }
 RESTfulRequestHandlerBuilder >> whenResponding: aMediaType encodeToJsonApplying: aBlock as: schema [
 
-	self whenResponding: aMediaType encodeApplying: [ :resource :requestContext | 
-		self
-			jsonFor: resource
-			within: requestContext
-			applying: aBlock
-			writingResourceWith: [ :writer | 
-				writer
-					for: ResourceCollection do: [ :mapping | 
-						( mapping mapInstVar: #items ) valueSchema: #ResourceCollectionItems.
-						mapping mapAsHypermediaControls: [ :collection | 
-								requestContext hypermediaControlsFor: collection items ]
-						];
-					for: #ResourceCollectionItems customDo: [ :mapping | mapping listOfElementSchema: schema ].
-
-				[ writer nextPut: resource as: schema ]
-					unless: ( resource isA: ResourceCollection )
-					inWhichCase: [ writer nextPut: resource ]
-				]
-		]
+  self whenResponding: aMediaType encodeApplying: [ :resource :requestContext |
+      self
+        jsonFor: resource
+        within: requestContext
+        applying: aBlock
+        writingResourceWith: [ :writer |
+            requestHandlerClass
+              encode: resource
+              toJsonUsing: writer
+              as: schema
+              within: requestContext
+          ]
+    ]
 ]