Merge pull request #7 from Mercap/http_transport_improvements

Fixed some HTTP transport related glitches

src/BaselineOfJRPC/BaselineOfJRPC.class.st

@@ -30,12 +30,20 @@ BaselineOfJRPC >> setUpPackages: spec [
 	spec
 		package: 'JRPC-Server' with: [ spec requires: 'JRPC-Common' ];
 		group: 'Server-Deployment' with: 'JRPC-Server'.
+	spec
+		for: #'pharo6.x'
+		do: [ spec
+				package: 'JRPC-Server-Pharo6';
+				group: 'Server-Deployment' with: 'JRPC-Server-Pharo6'
+	].	
 	spec
 		package: 'JRPC-Client' with: [ spec requires: 'JRPC-Common' ];
 		group: 'Client-Deployment' with: 'JRPC-Client'.
 	spec group: 'Deployment' with: #('Server-Deployment' 'Client-Deployment').
 
 	spec
 		package: 'JRPC-Tests' with: [ spec requires: 'Deployment' ];
-		group: 'Tests' with: 'JRPC-Tests'
+		group: 'Tests' with: 'JRPC-Tests'.
+
+
 ]

src/JRPC-Client/JRPCHTTPClient.class.st

@@ -7,7 +7,7 @@ Class {
 	#name : #JRPCHTTPClient,
 	#superclass : #JRPCClient,
 	#instVars : [
-		'url'
+		'httpClient'
 	],
 	#category : #'JRPC-Client'
 }
@@ -19,31 +19,36 @@ JRPCHTTPClient class >> url: anObject [
 		yourself
 ]
 
-{ #category : #private }
-JRPCHTTPClient >> httpClient [
-	^ ZnClient new
+{ #category : #options }
+JRPCHTTPClient >> ifFail: block [
+
+	httpClient ifFail: block
+]
+
+{ #category : #initialization }
+JRPCHTTPClient >> initialize [
+
+	super initialize.
+	httpClient := ZnClient new
 		systemPolicy;
 		http;
-		url: self url;
 		yourself
 ]
 
 { #category : #'private - sending' }
 JRPCHTTPClient >> sendRequest: aJRPCRequestObject [
+
 	| result |
-	result := self httpClient
-		contents: (self convertJRPCJsonableObjectToJSON: aJRPCRequestObject asJRPCJSON);
-		get.
-
-	^ self parseSupposedJRPCMessageObjectFromString: (result ifNil: [ '' ] ifNotNil: #contents).
-]
 
-{ #category : #accessing }
-JRPCHTTPClient >> url [
-	^ url
+	result := httpClient
+		contents: ( self convertJRPCJsonableObjectToJSON: aJRPCRequestObject asJRPCJSON );
+		post.
+
+	^ self parseSupposedJRPCMessageObjectFromString: ( result ifNil: [ '' ] ifNotNil: #contents )
 ]
 
 { #category : #accessing }
 JRPCHTTPClient >> url: anObject [
-	url := anObject asZnUrl
+
+	httpClient url: anObject asZnUrl
 ]

src/JRPC-Common/JRPCParser.trait.st

@@ -36,7 +36,10 @@ JRPCParser >> parseSupposedJRPCMessageObjectFromStream: aStream [
 
 { #category : #parsing }
 JRPCParser >> parseSupposedJRPCMessageObjectFromString: aString [
+
 	| readStream |
+
 	readStream := aString readStream.
-	[ ^ self parseSupposedJRPCMessageObjectFromStream: readStream ] ensure: [ readStream close ]
+	^ [ self parseSupposedJRPCMessageObjectFromStream: readStream ]
+		ensure: [ readStream close ]
 ]

src/JRPC-Server-Pharo6/ZnEntity.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #ZnEntity }
+
+{ #category : #'*JRPC-Server-Pharo6' }
+ZnEntity class >> json: text [
+
+	^ self stringEntityClass json: text
+]

src/JRPC-Server-Pharo6/ZnStringEntity.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : #ZnStringEntity }
+
+{ #category : #'*JRPC-Server-Pharo6' }
+ZnStringEntity class >> json: string [
+	^ (self type: ZnMimeType applicationJson)
+		string: string;
+		yourself
+]

src/JRPC-Server-Pharo6/package.st

@@ -0,0 +1 @@
+Package { #name : #'JRPC-Server-Pharo6' }

src/JRPC-Server/JRPCHTTPServer.class.st

@@ -22,19 +22,18 @@ JRPCHTTPServer >> defaultPort [
 	^ self class defaultPort
 ]
 
-{ #category : #'handling - http' }
-JRPCHTTPServer >> handleRequest: aRequest [
-	^ ZnResponse ok: (ZnEntity json: (self handleJSON: aRequest contents))
-]
-
 { #category : #initialization }
 JRPCHTTPServer >> initialize [
+
 	super initialize.
 	server := ZnServer defaultServerClass new.
-	
+
 	server
 		port: self defaultPort;
-		delegate: self
+		delegate:
+			( ZnDispatcherDelegate new
+				map: '/'
+				to: [ :request :response | response entity: ( ZnEntity json: ( self handleJSON: request contents ) ) ] )
 ]
 
 { #category : #accessing }

src/JRPC-Tests/JRPCHttpServerTest.class.st

@@ -0,0 +1,74 @@
+"
+I'm a test for JSON RPC over HTTP transport
+"
+Class {
+	#name : #JRPCHttpServerTest,
+	#superclass : #TestCase,
+	#instVars : [
+		'server'
+	],
+	#category : #'JRPC-Tests'
+}
+
+{ #category : #private }
+JRPCHttpServerTest >> checkPortAvailability [
+
+	[ ( ZnNetworkingUtils serverSocketOn: self port ) close ]
+		on: Error
+		do: [ :error | self fail: ( 'Port <1p> is not available' expandMacrosWith: self port ) ]
+]
+
+{ #category : #private }
+JRPCHttpServerTest >> port [
+
+	^ 7777
+]
+
+{ #category : #running }
+JRPCHttpServerTest >> setUp [
+
+	super setUp.
+	self checkPortAvailability.
+	server := JRPCServer http.
+	server port: self port.
+	server start
+]
+
+{ #category : #running }
+JRPCHttpServerTest >> tearDown [
+
+	server ifNotNil: [ server stop ].
+	server := nil.
+	super tearDown
+]
+
+{ #category : #accessing }
+JRPCHttpServerTest >> testRequestOnInvalidEndpoint [
+
+	| httpClient failed |
+
+	server addHandlerNamed: 'sum' block: [ :a :b | a + b ].
+	failed := false.
+
+	httpClient := JRPCClient http: ( 'http://localhost' asUrl port: self port ) / 'bad'.
+	httpClient
+		ifFail: [ :error | 
+			failed := true.
+			'{}'
+			].
+	self
+		should: [ httpClient callMethod: 'sum' arguments: #(1 3) withId: 1 ] raise: JRPCIncorrectJSON;
+		assert: failed
+]
+
+{ #category : #accessing }
+JRPCHttpServerTest >> testValidRequest [
+
+	| httpClient |
+
+	server addHandlerNamed: 'sum' block: [ :a :b | a + b ].
+
+	httpClient := JRPCClient http: ( 'http://localhost' asUrl port: self port ).
+
+	self assert: ( httpClient callMethod: 'sum' arguments: #(1 3) withId: 1 ) result equals: 4
+]