Add support for Cache-Control: no-store directive

source/Superluminal-RESTfulAPI-Tests/ExpiringCacheTest.class.st

@@ -37,15 +37,11 @@ ExpiringCacheTest >> obtain: answer cachedFor: aDuration [
 { #category : #private }
 ExpiringCacheTest >> resourceFor: answer expiringIn: aDuration [
 
-	| headers response |
-
-	headers := Dictionary new
-		at: 'Date' put: ( ZnUtils httpDate: currentDateTime );
-		at: 'Cache-Control' put: ( Array with: ( 'Max-Age=<1p>' expandMacrosWith: aDuration asSeconds ) );
-		yourself.
-	response := ZnResponse noContent
-		headers: headers;
-		yourself.
+	| response |
+
+	response := ZnResponse noContent.
+	response headers at: 'Date' put: ( ZnUtils httpDate: currentDateTime ).
+	response addCachingDirective: ( 'Max-Age=<1p>' expandMacrosWith: aDuration asSeconds ).
 	^ ExpiringResource for: answer controlledBy: response
 ]
 
@@ -55,7 +51,7 @@ ExpiringCacheTest >> setUp [
 	super setUp.
 	currentDateTime := DateAndTime now truncated.
 	currentTimeProvider := [ currentDateTime ].
-	location := UUID new asString.
+	location := 'answers' asUrl / UUID new asString.
 	self setUpExpiringCache
 ]
 

source/Superluminal-RESTfulAPI-Tests/ExpiringResourceTest.class.st

@@ -103,6 +103,34 @@ ExpiringResourceTest >> setUp [
 	currentDateTime := DateAndTime now truncated
 ]
 
+{ #category : #tests }
+ExpiringResourceTest >> testCanBeStored [
+
+	| resource |
+
+	self
+		assert: ( self resourceOriginatedAt: currentDateTime expiresContaining: 'not-a-date' ) canBeStored;
+		assert: ( self resourceOriginatedAt: currentDateTime expiringIn: 0 seconds ) canBeStored;
+		assert: ( self resourceWithNoCacheDirectiveOriginatedAt: currentDateTime ) canBeStored;
+		assert:
+			( self resourceWithNoCacheDirectiveOriginatedAt: currentDateTime expiringIn: 1 second )
+				canBeStored.
+
+
+	resource := self expiringResourceControlledBy: ( ( self responseWithDateHeader: currentDateTime )
+			              addCachingDirective: 'no-store';
+			              yourself ).
+
+	self deny: resource canBeStored.
+
+	resource := self expiringResourceControlledBy: ( ( self responseWithDateHeader: currentDateTime )
+			              addCachingDirective: 'no-cache';
+			              addCachingDirective: 'no-store';
+			              yourself ).
+
+	self deny: resource canBeStored
+]
+
 { #category : #tests }
 ExpiringResourceTest >> testExpiredWhenExpiresSetToInvalidDate [
 	"A cache recipient MUST interpret invalid date formats, especially the

source/Superluminal-RESTfulAPI-Tests/RESTfulAPIClientTest.class.st

@@ -20,7 +20,7 @@ RESTfulAPIClientTest >> apiClient [
 	^ self subclassResponsibility 
 ]
 
-{ #category : #tests }
+{ #category : #private }
 RESTfulAPIClientTest >> jsonOkResponse [
 
 	^ self jsonOkResponseWith: #(1 2 3)
@@ -32,7 +32,7 @@ RESTfulAPIClientTest >> location [
 	^ 'http://localhost' asAbsoluteUrl + resourceIdentifier
 ]
 
-{ #category : #tests }
+{ #category : #private }
 RESTfulAPIClientTest >> notFoundResponse [
 
 	^ ZnResponse notFound: self location
@@ -53,7 +53,7 @@ RESTfulAPIClientTest >> tearDown [
 	super tearDown
 ]
 
-{ #category : #tests }
+{ #category : #'tests - DELETE' }
 RESTfulAPIClientTest >> testDeleteAcceptingWithSuccessfulResponseDo [
 
 	| wasSuccessfull |
@@ -68,14 +68,14 @@ RESTfulAPIClientTest >> testDeleteAcceptingWithSuccessfulResponseDo [
 	self assert: wasSuccessfull
 ]
 
-{ #category : #tests }
+{ #category : #'tests - DELETE' }
 RESTfulAPIClientTest >> testDeleteAtSuccess [
 
 	self configureHttpClientToRespondWith: ZnResponse noContent.
 	self shouldnt: [ apiClient deleteAt: self location ] raise: HTTPClientError
 ]
 
-{ #category : #tests }
+{ #category : #'tests - DELETE' }
 RESTfulAPIClientTest >> testDeleteAtSuccessWhenCached [
 
 	| etagIsSet |
@@ -96,7 +96,7 @@ RESTfulAPIClientTest >> testDeleteAtSuccessWhenCached [
 	self assert: etagIsSet
 ]
 
-{ #category : #tests }
+{ #category : #'tests - DELETE' }
 RESTfulAPIClientTest >> testDeleteNotFound [
 
 	self configureHttpClientToRespondWith: self notFoundResponse.
@@ -110,7 +110,7 @@ RESTfulAPIClientTest >> testDeleteNotFound [
 		raise: HTTPClientError notFound
 ]
 
-{ #category : #tests }
+{ #category : #'tests - GET' }
 RESTfulAPIClientTest >> testGetAcceptingWithSuccessfulResponseDo [
 
 	self configureHttpClientToRespondWith: self jsonOkResponse.
@@ -122,29 +122,61 @@ RESTfulAPIClientTest >> testGetAcceptingWithSuccessfulResponseDo [
 			[ :responseContents | self withJsonFrom: responseContents do: [ :json | self assert: json equals: #(1 2 3) ] ]
 ]
 
-{ #category : #tests }
+{ #category : #'tests - GET' }
 RESTfulAPIClientTest >> testGetCached [
 
+	self configureHttpClientToRespondWith: ( ( self jsonOkResponseWith: #( 1 2 3 ) )
+			  addCachingDirective: 'Max-Age=60';
+			  yourself ).
+
+	apiClient get: self location withSuccessfulResponseDo: [ :responseContents |
+		self withJsonFrom: responseContents do: [ :json | self assert: json equals: #( 1 2 3 ) ] ].
+
+	self configureHttpClientToRespondWith: self notFoundResponse.
+
+	apiClient get: self location withSuccessfulResponseDo: [ :responseContents |
+		self withJsonFrom: responseContents do: [ :json | self assert: json equals: #( 1 2 3 ) ] ]
+]
+
+{ #category : #'tests - GET' }
+RESTfulAPIClientTest >> testGetDoNotStoreResponseInCache [
+
+	self configureHttpClientToRespondWith: ( ( self jsonOkResponseWith: #( 1 2 3 ) )
+			  addCachingDirective: 'no-store';
+			  yourself ).
+
+	apiClient get: self location withSuccessfulResponseDo: [ :responseContents |
+		self withJsonFrom: responseContents do: [ :json | self assert: json equals: #( 1 2 3 ) ] ].
+
+	self configureHttpClientToRespondWith: self notFoundResponse.
+
 	self
-		configureHttpClientToRespondWith:
-			( ( self jsonOkResponseWith: #(1 2 3) )
-				addCachingDirective: 'Max-Age=60';
-				yourself ).
+		should: [
+		apiClient get: self location withSuccessfulResponseDo: [ :responseContents | self fail ] ]
+		raise: HTTPClientError notFound
+]
 
-	apiClient
-		get: self location
-		withSuccessfulResponseDo:
-			[ :responseContents | self withJsonFrom: responseContents do: [ :json | self assert: json equals: #(1 2 3) ] ].
+{ #category : #'tests - GET' }
+RESTfulAPIClientTest >> testGetIgnoreETagsWhenDoNotStoreCachingPolicyIsInPlace [
 
-	self configureHttpClientToRespondWith: ( ZnResponse notFound: self location ).
+	self configureHttpClientToRespondWith: ( ( self jsonOkResponseWith: #( 1 2 3 ) )
+			  setEntityTag: '"123"';
+			  addCachingDirective: 'no-store';
+			  yourself ).
 
-	apiClient
-		get: self location
-		withSuccessfulResponseDo:
-			[ :responseContents | self withJsonFrom: responseContents do: [ :json | self assert: json equals: #(1 2 3) ] ]
+	apiClient get: self location withSuccessfulResponseDo: [ :responseContents |
+		self withJsonFrom: responseContents do: [ :json | self assert: json equals: #( 1 2 3 ) ] ].
+
+	self configureHttpClientToRespondWith: ( ( self jsonOkResponseWith: #( 1 2 3 ) )
+			  setEntityTag: '"123"';
+			  addCachingDirective: 'no-store';
+			  yourself ).
+
+	apiClient get: self location withSuccessfulResponseDo: [ :responseContents |
+		self withJsonFrom: responseContents do: [ :json | self assert: json equals: #( 1 2 3 ) ] ]
 ]
 
-{ #category : #tests }
+{ #category : #'tests - GET' }
 RESTfulAPIClientTest >> testGetNotFound [
 
 	self configureHttpClientToRespondWith: self notFoundResponse.
@@ -154,7 +186,32 @@ RESTfulAPIClientTest >> testGetNotFound [
 		raise: HTTPClientError notFound
 ]
 
-{ #category : #tests }
+{ #category : #'tests - GET' }
+RESTfulAPIClientTest >> testGetUsingETagInASecondInvocation [
+
+	| ifNoneMatchHeaderWasSet |
+
+	self configureHttpClientToRespondWith:
+		( ( self jsonOkResponseWith: #( 1 2 3 ) ) setEntityTag: '"123"' yourself ).
+
+	apiClient get: self location withSuccessfulResponseDo: [ :responseContents |
+		self withJsonFrom: responseContents do: [ :json | self assert: json equals: #( 1 2 3 ) ] ].
+
+	self configureHttpClientToRespondWith: ZnResponse notModified.
+
+	ifNoneMatchHeaderWasSet := false.
+	self httpClient whenSend: #setIfNoneMatchTo: evaluate: [ :etag |
+		self assert: etag equals: '"123"' asEntityTag.
+		ifNoneMatchHeaderWasSet := true
+		].
+
+	apiClient get: self location withSuccessfulResponseDo: [ :responseContents |
+		self withJsonFrom: responseContents do: [ :json | self assert: json equals: #( 1 2 3 ) ] ].
+
+	self assert: ifNoneMatchHeaderWasSet
+]
+
+{ #category : #'tests - GET' }
 RESTfulAPIClientTest >> testGetWithSuccessfulResponseDo [
 
 	self configureHttpClientToRespondWith: self jsonOkResponse.
@@ -165,7 +222,7 @@ RESTfulAPIClientTest >> testGetWithSuccessfulResponseDo [
 			[ :responseContents | self withJsonFrom: responseContents do: [ :json | self assert: json equals: #(1 2 3) ] ]
 ]
 
-{ #category : #tests }
+{ #category : #'tests - PATCH' }
 RESTfulAPIClientTest >> testPatchAtNoContent [
 
 	self configureHttpClientToRespondWith: ZnResponse noContent.
@@ -175,7 +232,7 @@ RESTfulAPIClientTest >> testPatchAtNoContent [
 		withSuccessfulResponseDo: [ :responseContents | self assert: responseContents isNil ]
 ]
 
-{ #category : #tests }
+{ #category : #'tests - PATCH' }
 RESTfulAPIClientTest >> testPatchAtNotFound [
 
 	self configureHttpClientToRespondWith: self notFoundResponse.
@@ -189,7 +246,7 @@ RESTfulAPIClientTest >> testPatchAtNotFound [
 		withMessageText: 'Cannot complete update'
 ]
 
-{ #category : #tests }
+{ #category : #'tests - PATCH' }
 RESTfulAPIClientTest >> testPatchAtWithSuccessfulResponseDo [
 
 	self configureHttpClientToRespondWith: self jsonOkResponse.
@@ -201,7 +258,7 @@ RESTfulAPIClientTest >> testPatchAtWithSuccessfulResponseDo [
 			[ :responseContents | self withJsonFrom: responseContents do: [ :json | self assert: json equals: #(1 2 3) ] ]
 ]
 
-{ #category : #tests }
+{ #category : #'tests - POST' }
 RESTfulAPIClientTest >> testPostBadRequest [
 
 	self
@@ -216,7 +273,7 @@ RESTfulAPIClientTest >> testPostBadRequest [
 		withMessageText: 'Cannot complete the request'
 ]
 
-{ #category : #tests }
+{ #category : #'tests - POST' }
 RESTfulAPIClientTest >> testPostWithSuccessfulResponseDo [
 
 	self configureHttpClientToRespondWith: ( ZnResponse created: self location ).
@@ -226,7 +283,7 @@ RESTfulAPIClientTest >> testPostWithSuccessfulResponseDo [
 		withSuccessfulResponseDo: [ :responseContents | self assert: ( responseContents beginsWith: 'Created' ) ]
 ]
 
-{ #category : #tests }
+{ #category : #'tests - PUT' }
 RESTfulAPIClientTest >> testPutAt [
 
 	| response |
@@ -238,7 +295,7 @@ RESTfulAPIClientTest >> testPutAt [
 	self withJsonFrom: response contents do: [ :json | self assert: json equals: #(1 2 3) ]
 ]
 
-{ #category : #tests }
+{ #category : #'tests - PUT' }
 RESTfulAPIClientTest >> testPutAtNoContent [
 
 	| response |
@@ -249,7 +306,7 @@ RESTfulAPIClientTest >> testPutAtNoContent [
 	self assert: response isNoContent
 ]
 
-{ #category : #tests }
+{ #category : #'tests - PUT' }
 RESTfulAPIClientTest >> testPutAtNotFound [
 
 	self configureHttpClientToRespondWith: self notFoundResponse.

source/Superluminal-RESTfulAPI/ExpiringCache.class.st

@@ -51,12 +51,16 @@ ExpiringCache >> withResourceAt: aBuiltKey obtainedUsing: aGetBlock do: aProcess
 
 	| resource |
 
-	[ resource := expiringResources get: aBuiltKey ]
-		on: KeyNotFound
-		do: [ :signal | 
-			resource := aGetBlock value.
-			expiringResources store: resource at: aBuiltKey
-			].
+	resource := [ expiringResources get: aBuiltKey ]
+		            on: KeyNotFound
+		            do: [ :notFound |
+			            | obtainedResource |
+
+			            obtainedResource := aGetBlock value.
+			            obtainedResource canBeStored then: [
+				            expiringResources store: obtainedResource at: aBuiltKey ].
+			            notFound return: obtainedResource
+			            ].
 
 	^ aProcessBlock value: resource contents
 ]

source/Superluminal-RESTfulAPI/ExpiringResource.class.st

@@ -14,6 +14,12 @@ ExpiringResource class >> for: aResource controlledBy: aResponse [
 	^ self new initializeFor: aResource controlledBy: aResponse
 ]
 
+{ #category : #testing }
+ExpiringResource >> canBeStored [
+
+	^ response canBeStoredInCache
+]
+
 { #category : #accessing }
 ExpiringResource >> contents [