Merge pull request #63 from ba-st/hosted-url

Automatically adapt the incoming request URL to appear as hosted in t…
ba-st · Oct 4, 2019 · 206d53c · 206d53c
2 parents 3e748b9 + bb3fc8d
commit 206d53c
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 5 deletions.
diff --git a/source/Stargate-Examples/PetsRESTfulController.class.st b/source/Stargate-Examples/PetsRESTfulController.class.st
@@ -164,7 +164,7 @@ PetsRESTfulController >> getPetsBasedOn: httpRequest within: requestContext [
 					end := pagination end min: total.
 					self
 						addPaginationControlsTo: requestContext
-						basedOn: ( httpRequest absoluteUrl asHostedAt: requestHandler resourceLocator baseUrl )
+						basedOn: httpRequest absoluteUrl
 						start: start
 						limit: pagination limit
 						end: end

diff --git a/source/Stargate-Model/HypermediaDrivenRESTfulRequestHandler.class.st b/source/Stargate-Model/HypermediaDrivenRESTfulRequestHandler.class.st
@@ -36,8 +36,7 @@ HypermediaDrivenRESTfulRequestHandler >> encodeResourceCollection: resourceColle
 	requestContext
 		holdAsHypermediaControls:
 			( self paginationPolicy
-				addPaginationControlsTo:
-					( Array with: 'self' -> ( httpRequest absoluteUrl asHostedAt: self resourceLocator baseUrl ) )
+				addPaginationControlsTo: ( Array with: 'self' -> httpRequest absoluteUrl )
 				within: requestContext )
 		for: resourceCollection.
 	resourceCollection do: [ :resource | self holdResource: resource controlsWithin: requestContext ].

diff --git a/source/Stargate-Model/RouteConfigurator.class.st b/source/Stargate-Model/RouteConfigurator.class.st
@@ -50,14 +50,23 @@ RouteConfigurator >> configureRouteFrom: aRouteSpecification [
 		perform: ( '<1s>:' expandMacrosWith: aRouteSpecification httpMethod ) asSymbol
 		with:
 			aRouteSpecification urlTemplate
-				-> [ :request | aRouteSpecification handler value: request value: HttpRequestContext new ]
+				-> [ :request | 
+					self withServerUrlDo: [ :url | request url: ( request url asHostedAt: url ) ].
+					aRouteSpecification handler value: request value: HttpRequestContext new
+					]
 ]
 
 { #category : #initialization }
 RouteConfigurator >> initializeAppliedTo: aTeapot sendingMessagesTo: aResourceRESTfulController [
 
 	teapot := aTeapot.
 	resourceController := aResourceRESTfulController.
-	teapot server serverUrl ifNotNil: [ :url | resourceController serverUrl: url ].
+	self withServerUrlDo: [ :url | resourceController serverUrl: url ].
 	routesAllowingCors := Dictionary new
 ]
+
+{ #category : #'private - configuring' }
+RouteConfigurator >> withServerUrlDo: aBlock [
+
+	teapot server serverUrl ifNotNil: aBlock
+]