Merge 6c1a7b5 into 80916f5

source/Superluminal-Model/BlockClosure.extension.st

@@ -3,5 +3,5 @@ Extension { #name : #BlockClosure }
 { #category : #'*Superluminal-Model' }
 BlockClosure >> asHttpRequestCommand [
 
-	^ CompositeHttpRequestCommand empty
+	^ (self value: HttpRequestBuilder new) ifNil: [ CompositeHttpRequestCommand empty ]
 ]

source/Superluminal-Model/HttpRequest.class.st

@@ -36,11 +36,10 @@ HttpRequest class >> post: aLocation configuredUsing: aMonadycBlock [
 { #category : #applying }
 HttpRequest >> applyOn: anHttpClient [
 
-	anHttpClient
-		url: url;
-		method: method.
+	anHttpClient request: ( ZnRequest method: method url: url ).
 
-	commands isNil ifFalse: [ commands applyOn: anHttpClient ].
+	commands isNil
+		ifFalse: [ commands applyOn: anHttpClient ].
 
 	^ anHttpClient
 		execute;
@@ -55,6 +54,6 @@ HttpRequest >> initializePerforming: anHttpMethod on: aLocation configuredUsing:
 	method := anHttpMethod.
 	url := aLocation.
 
-	configurator := HttpRequestConfigurator new.
+	configurator := HttpRequestBuilder new.
 	commands := aMonadycBlock cull: configurator
 ]

source/Superluminal-Model/HttpRequestBodySupplier.class.st → source/Superluminal-Model/HttpRequestBodyBuilder.class.st

@@ -1,26 +1,23 @@
 Class {
-	#name : #HttpRequestBodySupplier,
+	#name : #HttpRequestBodyBuilder,
 	#superclass : #Object,
-	#instVars : [
-		'commands'
-	],
 	#category : #'Superluminal-Model-Builders'
 }
 
 { #category : #configuring }
-HttpRequestBodySupplier >> contents: anEntity [
+HttpRequestBodyBuilder >> contents: anEntity [
 
 	^ SetBodyCommand to: anEntity
 ]
 
 { #category : #configuring }
-HttpRequestBodySupplier >> contents: anObject encodedAs: aMediaType [
+HttpRequestBodyBuilder >> contents: anObject encodedAs: aMediaType [
 
 	^ self contents: (ZnEntity with: anObject type: aMediaType)
 ]
 
 { #category : #configuring }
-HttpRequestBodySupplier >> formUrlEncoded: aBuildingBlock [
+HttpRequestBodyBuilder >> formUrlEncoded: aBuildingBlock [
 
 	| builder |
 
@@ -30,7 +27,7 @@ HttpRequestBodySupplier >> formUrlEncoded: aBuildingBlock [
 ]
 
 { #category : #configuring }
-HttpRequestBodySupplier >> json: aDictionary [
+HttpRequestBodyBuilder >> json: aDictionary [
 
 	| json |
 

source/Superluminal-Model/HttpRequestConfigurator.class.st → source/Superluminal-Model/HttpRequestBuilder.class.st

@@ -1,5 +1,5 @@
 Class {
-	#name : #HttpRequestConfigurator,
+	#name : #HttpRequestBuilder,
 	#superclass : #Object,
 	#instVars : [
 		'commands'
@@ -8,19 +8,19 @@ Class {
 }
 
 { #category : #configuring }
-HttpRequestConfigurator >> body [
+HttpRequestBuilder >> body [
 
-	^ HttpRequestBodySupplier new 
+	^ HttpRequestBodyBuilder new 
 ]
 
 { #category : #configuring }
-HttpRequestConfigurator >> headers [
+HttpRequestBuilder >> headers [
 
-	^ HttpRequestHeadersSupplier new
+	^ HttpRequestHeadersBuilder new
 ]
 
 { #category : #configuring }
-HttpRequestConfigurator >> queryString: aMonadycBlock [
+HttpRequestBuilder >> queryString: aMonadycBlock [
 
 	| builder |
 

source/Superluminal-Model/HttpRequestHeadersBuilder.class.st

@@ -0,0 +1,17 @@
+Class {
+	#name : #HttpRequestHeadersBuilder,
+	#superclass : #Object,
+	#category : #'Superluminal-Model-Builders'
+}
+
+{ #category : #supplying }
+HttpRequestHeadersBuilder >> setAcceptTo: aMediaType [
+
+	^ SetAcceptMediaTypeCommand to: aMediaType 
+]
+
+{ #category : #configuring }
+HttpRequestHeadersBuilder >> setBearerTokenTo: anOAuth2AccessToken [
+
+	^ SetBearerTokenCommand to: anOAuth2AccessToken
+]

source/Superluminal-Model/SetBearerTokenCommand.class.st

@@ -0,0 +1,26 @@
+Class {
+	#name : #SetBearerTokenCommand,
+	#superclass : #HttpRequestCommand,
+	#instVars : [
+		'token'
+	],
+	#category : #'Superluminal-Model-Commands'
+}
+
+{ #category : #'instance creation' }
+SetBearerTokenCommand class >> to: anOAuth2AccessToken [ 
+
+	^ self new initializeTo: anOAuth2AccessToken 
+]
+
+{ #category : #applying }
+SetBearerTokenCommand >> applyOn: anHttpClient [
+
+	anHttpClient headerAt: #Authorization put: ( #'Bearer <1p>' expandMacrosWith: token )
+]
+
+{ #category : #initialization }
+SetBearerTokenCommand >> initializeTo: anOAuth2AccessToken [ 
+
+	token := anOAuth2AccessToken 
+]

source/Superluminal-Tests/HttpRequestTest.class.st

@@ -54,7 +54,7 @@ HttpRequestTest >> testComposite [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assert: json url equals: 'https://httpbin.org/anything?last_name=fox&first_name=fran';
+				assert: json url equals: 'http://httpbin.org/anything?last_name=fox&first_name=fran';
 				assert: json method equals: 'GET';
 				assert: json headers Accept equals: 'application/vnd.nap.full_name+json;version=1.0.0' ]
 ]
@@ -74,7 +74,7 @@ HttpRequestTest >> testGet [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assert: json url equals: 'https://httpbin.org/anything';
+				assert: json url equals: 'http://httpbin.org/anything';
 				assert: json method equals: 'GET' ]
 ]
 
@@ -94,7 +94,7 @@ HttpRequestTest >> testGetWithEmptyConfiguration [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assert: json url equals: 'https://httpbin.org/anything';
+				assert: json url equals: 'http://httpbin.org/anything';
 				assert: json method equals: 'GET' ]
 ]
 
@@ -121,7 +121,7 @@ HttpRequestTest >> testPostEncodedAsJson [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assert: json url equals: 'https://httpbin.org/anything';
+				assert: json url equals: 'http://httpbin.org/anything';
 				assert: json method equals: 'POST';
 				assert: json data equals: '{"last_name":"fox","first_name":"fran"}';
 				assert: ( json headers at: #'Content-Type' ) equals: 'application/json'
@@ -146,7 +146,7 @@ HttpRequestTest >> testPostEncodedDataAndMediaType [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assert: json url equals: 'https://httpbin.org/anything';
+				assert: json url equals: 'http://httpbin.org/anything';
 				assert: json method equals: 'POST';
 				assert: json data equals: '{"last_name":"fox","first_name":"fran"}';
 				assert: (json headers at: #'Content-Type')
@@ -174,7 +174,7 @@ HttpRequestTest >> testPostFormUrlEncoded [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assert: json url equals: 'https://httpbin.org/anything';
+				assert: json url equals: 'http://httpbin.org/anything';
 				assert: json method equals: 'POST';
 				assert: json form asDictionary
 					equals:
@@ -183,35 +183,6 @@ HttpRequestTest >> testPostFormUrlEncoded [
 				assert: (json headers at: #'Content-Type') equals: 'application/x-www-form-urlencoded' ]
 ]
 
-{ #category : #tests }
-HttpRequestTest >> testPostSettingJsonBodyAndContentType [
-
-	| httpRequest response |
-
-	httpRequest := HttpRequest
-		post: 'http://httpbin.org/anything'
-		configuredUsing: [ :request | 
-			( request body
-				json:
-					( Dictionary new
-						at: 'first_name' put: 'fran';
-						at: 'last_name' put: 'fox';
-						yourself ) ) + ( request headers setContentTypeTo: 'application/json;version=1.0.0' )
-			].
-
-	response := httpRequest applyOn: ZnClient new.
-
-	self
-		withJsonFromContentsIn: response
-		do: [ :json | 
-			self
-				assert: json url equals: 'https://httpbin.org/anything';
-				assert: json method equals: 'POST';
-				assert: json data equals: '{"last_name":"fox","first_name":"fran"}';
-				assert: ( json headers at: #'Content-Type' ) equals: 'application/json;version=1.0.0'
-			]
-]
-
 { #category : #tests }
 HttpRequestTest >> testPostUsingEntity [
 
@@ -228,7 +199,7 @@ HttpRequestTest >> testPostUsingEntity [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assert: json url equals: 'https://httpbin.org/anything';
+				assert: json url equals: 'http://httpbin.org/anything';
 				assert: json method equals: 'POST';
 				assert: json data
 					equals: '{"last_name":"fox","first_name":"fran"}';
@@ -257,7 +228,7 @@ HttpRequestTest >> testQueryString [
 		withJsonFromContentsIn: response
 		do: [ :json | 
 			self
-				assert: json url equals: 'https://httpbin.org/anything?last_name=fox&first_name=fran';
+				assert: json url equals: 'http://httpbin.org/anything?last_name=fox&first_name=fran';
 				assert: json method equals: 'GET' ]
 ]
 

source/Superluminal-Tests/SetBasicAuthenticationCommandTest.class.st

@@ -0,0 +1,17 @@
+Class {
+	#name : #SetBasicAuthenticationCommandTest,
+	#superclass : #TestCase,
+	#category : #'Superluminal-Tests-Commands'
+}
+
+{ #category : #tests }
+SetBasicAuthenticationCommandTest >> testApplyOn [
+
+	| httpClient command |
+
+	httpClient := ZnClient new.
+	command := SetBasicAuthenticationCommand with: 'user' password: 'password'.
+	command applyOn: httpClient.
+
+	self assert: ( httpClient request headers at: #Authorization ) equals: 'Basic dXNlcjpwYXNzd29yZA=='
+]

source/Superluminal-Tests/SetBearerTokenCommandTest.class.st

@@ -0,0 +1,17 @@
+Class {
+	#name : #SetBearerTokenCommandTest,
+	#superclass : #TestCase,
+	#category : #'Superluminal-Tests-Commands'
+}
+
+{ #category : #tests }
+SetBearerTokenCommandTest >> testApplyOn [
+
+	| httpClient command |
+
+	httpClient := ZnClient new.
+	command := SetBearerTokenCommand to: 'token'.
+	command applyOn: httpClient.
+
+	self assert: ( httpClient request headers at: #Authorization ) equals: 'Bearer ''token'''
+]

source/Superluminal-Tests/SetBodyCommandTest.class.st

@@ -19,3 +19,19 @@ SetBodyCommandTest >> testApplyOn [
 		assert: httpClient request contentType equals: 'application/json' asMIMEType;
 		assert: httpClient request contents equals: json
 ]
+
+{ #category : #tests }
+SetBodyCommandTest >> testApplyOnUsingMimeType [
+
+	| httpClient command json |
+
+	httpClient := ZnClient new.
+	json := '{"last_name":"fox","first_name":"fran"}'.
+	command := SetBodyCommand to: ( ZnEntity with: json type: 'application/vnd.mercap.objective+json' asMIMEType ).
+	command applyOn: httpClient.
+
+	self
+		assert: httpClient request contentLength equals: json size;
+		assert: httpClient request contentType equals: 'application/vnd.mercap.objective+json' asMIMEType;
+		assert: httpClient request contents equals: json
+]