Merge pull request #127 from ba-st/126-Access-Control-Allow-Origin-sh…

…ould-match-the-Origin-

force Access-Control-Allow-Origin to have a valid origin format

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

@@ -11,6 +11,14 @@ Class {
 	#category : #'Stargate-Examples-Tests-PetStore'
 }
 
+{ #category : #'tests - support' }
+PetStoreAPITest >> assert: aResponse canBeSharedWithRequestsFrom: anOriginLocation [
+
+	self
+		assert: ( aResponse headers at: 'Access-Control-Allow-Origin' )
+		equals: anOriginLocation asWebOrigin asString
+]
+
 { #category : #private }
 PetStoreAPITest >> controllersToInstall [
 
@@ -94,7 +102,7 @@ PetStoreAPITest >> testCORSAllowingExactlyOneOrigin [
 
 	self
 		assert: response isNoContent;
-		assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self baseUrl;
+		assert: response canBeSharedWithRequestsFrom: self baseUrl;
 		assert: ( response headers at: 'Access-Control-Allow-Headers' ) equals: 'Content-Type';
 		assert: response varyHeaderNames includes: 'Access-Control-Allow-Headers';
 		deny: response varyHeaderNames includes: 'Access-Control-Allow-Origin';
@@ -109,7 +117,7 @@ PetStoreAPITest >> testCORSAllowingExactlyOneOrigin [
 	self
 		deny: response varyHeaderNames includes: 'Access-Control-Allow-Headers';
 		deny: response varyHeaderNames includes: 'Access-Control-Allow-Origin';
-		assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self baseUrl
+		assert: response canBeSharedWithRequestsFrom: self baseUrl
 ]
 
 { #category : #'tests - CORS' }
@@ -134,7 +142,7 @@ PetStoreAPITest >> testCORSAllowingMoreThanOneOrigin [
 
 	self
 		assert: response isNoContent;
-		assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self baseUrl;
+		assert: response canBeSharedWithRequestsFrom: self baseUrl;
 		assert: ( response headers at: 'Access-Control-Allow-Headers' ) equals: 'Content-Type';
 		assert: response varyHeaderNames includes: 'Origin';
 		assert: response varyHeaderNames includes: 'Access-Control-Allow-Headers';
@@ -149,7 +157,7 @@ PetStoreAPITest >> testCORSAllowingMoreThanOneOrigin [
 	self
 		assert: response varyHeaderNames includes: 'Origin';
 		deny: response varyHeaderNames includes: 'Access-Control-Allow-Headers';
-		assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self baseUrl
+		assert: response canBeSharedWithRequestsFrom:  self baseUrl
 ]
 
 { #category : #'tests - CORS' }

source/Stargate-Model-Tests/CrossOriginResourceSharingActualRequestHandlerTest.class.st

@@ -4,6 +4,14 @@ Class {
 	#category : #'Stargate-Model-Tests-CORS'
 }
 
+{ #category : #'tests - support' }
+CrossOriginResourceSharingActualRequestHandlerTest >> assert: aResponse canBeSharedWithRequestsFrom: anOriginLocation [
+
+	self
+		assert: ( aResponse headers at: 'Access-Control-Allow-Origin' )
+		equals: anOriginLocation asWebOrigin asString
+]
+
 { #category : #'tests - support' }
 CrossOriginResourceSharingActualRequestHandlerTest >> assert: aHandlerBuilderConfiguration handles: aRequest byResponding: responseAssertions [
 
@@ -97,7 +105,7 @@ CrossOriginResourceSharingActualRequestHandlerTest >> testAllowExactlyOneOrigin
 		byResponding: [ :response | 
 			self
 				assert: response isCreated;
-				assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self websiteLocation;
+				assert: response canBeSharedWithRequestsFrom: self websiteLocation;
 				should: [ response headers at: 'Vary' ] raise: KeyNotFound
 			]
 ]
@@ -120,7 +128,7 @@ CrossOriginResourceSharingActualRequestHandlerTest >> testAllowMoreThanOneOrigin
 		byResponding: [ :response | 
 			self
 				assert: response isCreated;
-				assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self websiteLocation;
+				assert: response canBeSharedWithRequestsFrom: self websiteLocation;
 				assert: ( response headers at: 'Vary' ) equals: 'Origin'
 			]
 ]

source/Stargate-Model-Tests/CrossOriginResourceSharingPreflightHandlerTest.class.st

@@ -7,6 +7,14 @@ Class {
 	#category : #'Stargate-Model-Tests-CORS'
 }
 
+{ #category : #'tests - support' }
+CrossOriginResourceSharingPreflightHandlerTest >> assert: aResponse canBeSharedWithRequestsFrom: anOriginLocation [
+
+	self
+		assert: ( aResponse headers at: 'Access-Control-Allow-Origin' )
+		equals: anOriginLocation asWebOrigin asString
+]
+
 { #category : #'tests - support' }
 CrossOriginResourceSharingPreflightHandlerTest >> assert: aHandlerBuilderConfiguration handles: aRequest byResponding: responseAssertions [
 
@@ -137,8 +145,7 @@ CrossOriginResourceSharingPreflightHandlerTest >> testAllowExactlyOneOrigin [
 		handles: request
 		byResponding: [ :response | 
 			self
-				assertUrl: ( response headers at: 'Access-Control-Allow-Origin' )
-					equals: self websiteLocation;
+				assert: response canBeSharedWithRequestsFrom: self websiteLocation;
 				assert: ( response headers at: 'Access-Control-Allow-Headers' ) equals: 'Content-Type';
 				assert: ( response headers at: 'Vary' ) equals: 'Access-Control-Allow-Headers';
 				assert: ( response headers at: 'Access-Control-Allow-Methods' ) equals: 'GET, POST'
@@ -168,7 +175,7 @@ CrossOriginResourceSharingPreflightHandlerTest >> testAllowHeadersMatchRequestHe
 		handles: request
 		byResponding: [ :response | 
 			self
-				assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self websiteLocation;
+				assert: response canBeSharedWithRequestsFrom: self websiteLocation;
 				assert: ( response headers at: 'Access-Control-Allow-Methods' ) equals: 'GET, POST';
 				assert: ( response headers at: 'Access-Control-Allow-Headers' )
 					equals: 'Content-Type, Authorization';
@@ -199,7 +206,7 @@ CrossOriginResourceSharingPreflightHandlerTest >> testAllowHeadersWithEmptyReque
 		handles: request
 		byResponding: [ :response | 
 			self
-				assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self websiteLocation;
+				assert: response canBeSharedWithRequestsFrom: self websiteLocation;
 				assert: ( response headers at: 'Access-Control-Allow-Methods' ) equals: 'GET, POST';
 				should: [ response headers at: 'Access-Control-Allow-Headers' ] raise: NotFound;
 				should: [ response headers at: 'Vary' ] raise: KeyNotFound
@@ -231,7 +238,7 @@ CrossOriginResourceSharingPreflightHandlerTest >> testAllowMoreThanOneOrigin [
 		handles: request
 		byResponding: [ :response | 
 			self
-				assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self websiteLocation;
+				assert: response canBeSharedWithRequestsFrom: self websiteLocation;
 				assert: ( response headers at: 'Access-Control-Allow-Headers' ) equals: 'Content-Type';
 				assert: response varyHeaderNames equals: #('Origin' 'Access-Control-Allow-Headers');
 				assert: ( response headers at: 'Access-Control-Allow-Methods' ) equals: 'GET, POST'
@@ -267,7 +274,7 @@ CrossOriginResourceSharingPreflightHandlerTest >> testAllowedMethodsReflectsDefi
 		handles: request
 		byResponding: [ :response | 
 			self
-				assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self websiteLocation;
+				assert: response canBeSharedWithRequestsFrom: self websiteLocation;
 				assert: ( response headers at: 'Access-Control-Allow-Headers' ) equals: 'Content-Type';
 				assert: ( response headers at: 'Vary' ) equals: 'Access-Control-Allow-Headers';
 				assert: ( response headers at: 'Access-Control-Allow-Methods' ) equals: 'GET'
@@ -292,8 +299,7 @@ CrossOriginResourceSharingPreflightHandlerTest >> testAllowedMethodsReflectsDefi
 		handles: request
 		byResponding: [ :response | 
 			self
-				assertUrl: ( response headers at: 'Access-Control-Allow-Origin' )
-					equals: self websiteLocation;
+				assert:  response canBeSharedWithRequestsFrom: self websiteLocation;
 				assert: ( response headers at: 'Access-Control-Allow-Headers' ) equals: 'Content-Type';
 				assert: ( response headers at: 'Vary' ) equals: 'Access-Control-Allow-Headers';
 				assert: ( response headers at: 'Access-Control-Allow-Methods' ) equals: 'GET, POST, PUT'
@@ -327,7 +333,7 @@ CrossOriginResourceSharingPreflightHandlerTest >> testAllowedMethodsReflectsDefi
 		handles: request
 		byResponding: [ :response | 
 			self
-				assertUrl: ( response headers at: 'Access-Control-Allow-Origin' ) equals: self websiteLocation;
+				assert: response canBeSharedWithRequestsFrom: self websiteLocation;
 				assert: ( response headers at: 'Access-Control-Allow-Headers' ) equals: 'Content-Type';
 				assert: ( response headers at: 'Vary' ) equals: 'Access-Control-Allow-Headers';
 				assert: ( response headers at: 'Access-Control-Allow-Methods' ) equals: 'GET, POST'

source/Stargate-Model-Tests/WebOriginTest.class.st

@@ -0,0 +1,45 @@
+Class {
+	#name : #WebOriginTest,
+	#superclass : #TestCase,
+	#category : #'Stargate-Model-Tests-Routing'
+}
+
+{ #category : #tests }
+WebOriginTest >> testComparing [
+
+	self assert: 'http://example.com/' asWebOrigin hash equals: 'http://example.com' hash.
+	self assert: 'http://example.com/' asWebOrigin equals: 'http://example.com'.
+	self assert: 'http://example.com:80/' asWebOrigin equals: 'http://example.com'.
+	self assert: 'http://example.com/path/file' asWebOrigin equals: 'http://example.com'.
+	self assert: 'http://example.com:8080/' asWebOrigin equals: 'http://example.com:8080'.
+	self assert: 'http://www.example.com/' asWebOrigin equals: 'http://www.example.com'.
+	self assert: 'https://example.com:443/' asWebOrigin equals: 'https://example.com'.
+	self assert: 'https://example.com/' asWebOrigin equals: 'https://example.com'.
+	self assert: 'http://example.org/' asWebOrigin equals: 'http://example.org'.
+	self assert: 'http://ietf.org/' asWebOrigin equals: 'http://ietf.org'.
+	self assert: 'http://127.0.0.1:8081/the/path/' asWebOrigin equals: 'http://127.0.0.1:8081'.
+	self assert: 'https://[email protected]:123/forum/questions?id=1' asWebOrigin equals: 'https://www.example.com:123'.
+	self
+		should: [ 'mailto:[email protected]' asWebOrigin ]
+		raise: InstanceCreationFailed
+		withMessageText: 'mailto:[email protected] does not comply with a valid origin'
+]
+
+{ #category : #tests }
+WebOriginTest >> testValidOrigins [
+
+	self assert: 'http://example.com/' asUrl hasValidOrigin.
+	self assert: 'http://example.com:80/' asUrl hasValidOrigin.
+	self assert: 'http://example.com/path/file' asUrl hasValidOrigin.
+	self assert: 'http://example.com:8080/' asUrl hasValidOrigin.
+	self assert: 'http://www.example.com/' asUrl hasValidOrigin.
+	self assert: 'https://example.com:80/' asUrl hasValidOrigin.
+	self assert: 'https://example.com/' asUrl hasValidOrigin.
+	self assert: 'http://example.org/' asUrl hasValidOrigin.
+	self assert: 'http://ietf.org/' asUrl hasValidOrigin.
+	self assert: 'http://127.0.0.1:8081/the/path/' asUrl hasValidOrigin.
+	self assert: 'https://[email protected]:123/forum/questions?id=1' asUrl hasValidOrigin.
+	self assert: 'https://[email protected]:123/forum/questions?id=1' asUrl hasValidOrigin.
+	self deny: 'mailto:[email protected]' asUrl hasValidOrigin.
+
+]

source/Stargate-Model/AllowAnyOriginPolicy.class.st

@@ -8,7 +8,7 @@ Class {
 }
 
 { #category : #'configuring headers' }
-AllowAnyOriginPolicy >> applyOn: aResponse for: aRequest using: aHandler [ 
+AllowAnyOriginPolicy >> applyOn: aResponse for: aRequest using: aHandler [
 
-	aHandler set: '*' asAllowOriginOn: aResponse 
+	aHandler setAnyOriginAllowedOn: aResponse
 ]

source/Stargate-Model/AllowSpecifiedOriginsPolicy.class.st

@@ -11,17 +11,17 @@ Class {
 }
 
 { #category : #'instance creation' }
-AllowSpecifiedOriginsPolicy class >> onlyFrom: origins [
-	
-	^ self new initializeOnlyFrom: origins
+AllowSpecifiedOriginsPolicy class >> onlyFrom: anUrlCollection [
+
+	^ self new initializeOnlyFrom: ( anUrlCollection collect: #asWebOrigin )
 ]
 
 { #category : #'configuring headers' }
 AllowSpecifiedOriginsPolicy >> applyOn: aResponse for: aRequest using: aHandler [
 
 	| requestOrigin |
 
-	requestOrigin := ( aRequest headers at: aHandler headerNames >> #origin ) asUrl.
+	requestOrigin := ( aRequest headers at: aHandler headerNames >> #origin ) asWebOrigin.
 
 	allowedOrigins
 		detect: [ :origin | origin = requestOrigin ]
@@ -36,5 +36,5 @@ AllowSpecifiedOriginsPolicy >> applyOn: aResponse for: aRequest using: aHandler
 { #category : #initialization }
 AllowSpecifiedOriginsPolicy >> initializeOnlyFrom: origins [
 
-	allowedOrigins := origins 
+	allowedOrigins := origins
 ]

source/Stargate-Model/CrossOriginResourceSharingHandler.class.st

@@ -14,7 +14,13 @@ CrossOriginResourceSharingHandler >> headerNames [
 ]
 
 { #category : #'private - evaluating' }
-CrossOriginResourceSharingHandler >> set: anyOrAnOrigin asAllowOriginOn: aResponse [
+CrossOriginResourceSharingHandler >> set: anOrigin asAllowOriginOn: aResponse [
 
-	aResponse headers at: self headerNames >> #accessControlAllowOrigin put: anyOrAnOrigin asString 
+	aResponse headers at: self headerNames >> #accessControlAllowOrigin put: anOrigin asString
+]
+
+{ #category : #'private - evaluating' }
+CrossOriginResourceSharingHandler >> setAnyOriginAllowedOn: aResponse [
+
+	aResponse headers at: self headerNames >> #accessControlAllowOrigin put: '*'
 ]

source/Stargate-Model/String.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #String }
+
+{ #category : #'*Stargate-Model' }
+String >> asWebOrigin [ 
+
+	^ self asUrl asWebOrigin 
+]

source/Stargate-Model/WebOrigin.class.st

@@ -0,0 +1,74 @@
+"
+I represent a web origin as defined in the RFC 6454.
+I have the format 
+	scheme '://' host [ ':' port ]
+with <scheme>, <host>, <port> from RFC 3986.
+	
+The // precedes the authority component of the uri, and thus I accept the schemes
+that may have the authority component. Currently #(http https) but this can be extended at will. 
+	
+References
+	https://tools.ietf.org/html/rfc6454
+	https://tools.ietf.org/html/rfc3986
+"
+Class {
+	#name : #WebOrigin,
+	#superclass : #Object,
+	#instVars : [
+		'url'
+	],
+	#category : #'Stargate-Model-CORS'
+}
+
+{ #category : #'instance creation' }
+WebOrigin class >> basedOn: aUrl [
+
+	AssertionChecker
+		enforce: [ self hasValidOrigin: aUrl ]
+		because: [ '<1p> does not comply with a valid origin' expandMacrosWith: aUrl ]
+		raising: InstanceCreationFailed.
+
+	^ self new initializeBasedOn: aUrl
+]
+
+{ #category : #preconditions }
+WebOrigin class >> hasValidOrigin: aUrl [
+
+	| validOriginSchemes |
+
+	validOriginSchemes := #(#http #https).
+
+	^ aUrl hasScheme and: [ ( validOriginSchemes includes: aUrl scheme ) and: [ aUrl hasHost ] ]
+]
+
+{ #category : #comparing }
+WebOrigin >> = aWebOrigin [
+
+	^ self asString = aWebOrigin asString
+]
+
+{ #category : #comparing }
+WebOrigin >> hash [
+
+	^ self asString hash
+]
+
+{ #category : #initialization }
+WebOrigin >> initializeBasedOn: aUrl [ 
+
+	url := aUrl
+]
+
+{ #category : #printing }
+WebOrigin >> printOn: stream [
+
+	stream
+		nextPutAll: url scheme;
+		nextPutAll: '://';
+		nextPutAll: url host.
+	url hasNonDefaultPort
+		then: [ stream
+				nextPut: $:;
+				print: url port
+			]
+]

source/Stargate-Model/ZnUrl.extension.st

@@ -0,0 +1,13 @@
+Extension { #name : #ZnUrl }
+
+{ #category : #'*Stargate-Model' }
+ZnUrl >> asWebOrigin [
+
+	^ WebOrigin basedOn: self 
+]
+
+{ #category : #'*Stargate-Model' }
+ZnUrl >> hasValidOrigin [
+
+	^ WebOrigin hasValidOrigin: self
+]