Improvements to HTTP client SCL API

Added support for: POST, PUT, DELETE, asynchronous requests, forms,
media types, multi part content, reading response status.

refs #7774

Change-Id: I5220ae0a3bb07b616f9e54c0668a52607114b7a1

diff --git a/bundles/org.simantics.scl.rest/META-INF/MANIFEST.MF b/bundles/org.simantics.scl.rest/META-INF/MANIFEST.MF
index e92a3cf0ceff3bb21b99bfb23ef97950a6420471..429a733d8fc8ecca77099509900bc3b0e772a1d8 100644 (file)
--- a/bundles/org.simantics.scl.rest/META-INF/MANIFEST.MF
+++ b/bundles/org.simantics.scl.rest/META-INF/MANIFEST.MF
@@ -21,6 +21,8 @@ Require-Bundle: org.eclipse.core.runtime,
  org.glassfish.jersey.media.jersey-media-json-jackson;bundle-version="2.25.1",
  org.glassfish.jersey.media.jersey-media-multipart;bundle-version="2.25.1",
  org.slf4j.api,
  org.glassfish.jersey.media.jersey-media-json-jackson;bundle-version="2.25.1",
  org.glassfish.jersey.media.jersey-media-multipart;bundle-version="2.25.1",
  org.slf4j.api,

- org.jvnet.mimepull;bundle-version="1.9.6"
+ org.jvnet.mimepull;bundle-version="1.9.6",
+ org.glassfish.jersey.core.jersey-client,
+ org.glassfish.jersey.core.jersey-common;bundle-version="2.25.1"

 Bundle-RequiredExecutionEnvironment: JavaSE-1.8
 Bundle-ActivationPolicy: lazy
 Bundle-RequiredExecutionEnvironment: JavaSE-1.8
 Bundle-ActivationPolicy: lazy

diff --git a/bundles/org.simantics.scl.rest/scl/HTTP/Client.scl b/bundles/org.simantics.scl.rest/scl/HTTP/Client.scl
index 76b0b63c4a59534ae58cded7adb27c47bc541a71..34fc6a77edcb620f96b3a4ceff0e1014cd447c78 100644 (file)
--- a/bundles/org.simantics.scl.rest/scl/HTTP/Client.scl
+++ b/bundles/org.simantics.scl.rest/scl/HTTP/Client.scl
@@ -1,39 +1,88 @@
-import "Map" as Map

 import "Vector"
 import "Vector"

-import "Logging" as LOGGER
+import "File"
+import "HTTP/Form"
+import "HTTP/MultiPart"
+import "HTTP/MediaType"
+import "Future"
+
+type ResponseHandler = Response -> <Proc> ()
+type FailureHandler = Throwable -> <Proc> ()
+
+NO_RESPONSE_HANDLER = (\response -> ()) :: ResponseHandler 
+NO_FAILURE_HANDLER = (\failure -> ()) :: FailureHandler 

 
 importJava "javax.ws.rs.client.Invocation" where
     data Invocation
 
     @JavaName invoke
 
 importJava "javax.ws.rs.client.Invocation" where
     data Invocation
 
     @JavaName invoke

-    invoke_ :: Invocation -> Class a -> <Proc, Exception> a
+    syncInvoke :: Invocation -> <Proc, Exception> Response
+
+importJava "javax.ws.rs.core.Response" where
+    data Response
+    @JavaName getStatus
+    statusCodeOf :: Response -> <Proc> Integer
+    @Private
+    @JavaName readEntity
+    readEntity_ :: Response -> Class a -> <Proc, Exception> a

 
 

-invoke :: VecComp a => Invocation -> <Proc, Exception> a
-invoke invocation = invoke_ invocation classObject
+readEntity :: VecComp a => Response -> <Proc, Exception> a
+readEntity response = readEntity_ response classObject

 
 importJava "javax.ws.rs.client.Invocation$Builder" where
     data Builder
     
     header :: Builder -> String -> String -> <Proc> Builder
 
 importJava "javax.ws.rs.client.Invocation$Builder" where
     data Builder
     
     header :: Builder -> String -> String -> <Proc> Builder

-    accept :: Builder -> Vector String -> <Proc> Builder
+    @private
+    @JavaName accept
+    acceptMediaType_ :: Builder -> Vector MediaType -> <Proc> Builder
+    @private
+    @JavaName acceptEncoding
+    acceptEncoding_ :: Builder -> Vector String -> <Proc> Builder
+    @private
+    @JavaName acceptLanguage
+    acceptLanguage_ :: Builder -> Vector String -> <Proc> Builder

     cookie :: Builder -> String -> String -> <Proc> Builder
     build :: Builder -> String -> <Proc> Invocation
     cookie :: Builder -> String -> String -> <Proc> Builder
     build :: Builder -> String -> <Proc> Invocation

+    buildGet :: Builder -> <Proc> Invocation
+    buildPost :: Builder -> Entity -> <Proc> Invocation
+    buildDelete :: Builder -> <Proc> Invocation
+    buildPut :: Builder -> Entity -> <Proc> Invocation
+
+acceptMediaType :: Builder -> [MediaType] -> <Proc> Builder
+acceptMediaType builder mediaTypes =
+    acceptMediaType_ builder $ vector mediaTypes
+
+acceptEncoding :: Builder -> [String] -> <Proc> Builder
+acceptEncoding builder encodings =
+    acceptEncoding_ builder $ vector encodings
+
+acceptLanguage :: Builder -> [String] -> <Proc> Builder
+acceptLanguage builder languages =
+    acceptEncoding_ builder $ vector languages

 
 importJava "javax.ws.rs.client.WebTarget" where
     data WebTarget
 
     path :: WebTarget -> String -> <Proc> WebTarget
 
 importJava "javax.ws.rs.client.WebTarget" where
     data WebTarget
 
     path :: WebTarget -> String -> <Proc> WebTarget

-    queryParam :: WebTarget -> String -> Vector String -> <Proc> WebTarget
-    request :: WebTarget -> Vector String -> <Proc> Builder
+    request :: WebTarget -> <Proc> Builder

 
 importJava "javax.ws.rs.client.ClientBuilder" where
     data ClientBuilder
     
     @JavaName newBuilder
     clientBuilder :: <Proc> ClientBuilder
 
 importJava "javax.ws.rs.client.ClientBuilder" where
     data ClientBuilder
     
     @JavaName newBuilder
     clientBuilder :: <Proc> ClientBuilder

-    
-    @JavaName build
+
+importJava "org.simantics.scl.rest.HttpClientUtils" where

     buildClient :: ClientBuilder -> Client
     buildClient :: ClientBuilder -> Client

+    statusMessageOf :: Response -> <Proc> String
+    asyncInvoke :: Invocation -> ResponseHandler -> FailureHandler -> <Proc> Future Response
+
+importJava "javax.ws.rs.client.Entity" where
+    data Entity
+    
+    @JavaName form
+    formEntity :: Form -> <Proc> Entity
+    entity :: a -> MediaType -> <Proc> Entity

 
 importJava "javax.ws.rs.client.Client" where
     data Client
 
 importJava "javax.ws.rs.client.Client" where
     data Client


@@ -41,13 +90,80 @@ importJava "javax.ws.rs.client.Client" where
     target :: Client -> String -> <Proc> WebTarget
     close :: Client -> <Proc> ()
 
     target :: Client -> String -> <Proc> WebTarget
     close :: Client -> <Proc> ()
 

-getTextHtmlExample :: String -> Map.T String a -> <Proc, Exception> String
-getTextHtmlExample uri queryParams = do
+/*
+Example usage:
+
+getExample :: String -> <Proc, Exception> String
+getExample uri = do

     httpClient = buildClient clientBuilder
     webTarget = target httpClient uri
     httpClient = buildClient clientBuilder
     webTarget = target httpClient uri

-    req = request webTarget (vector ["text/html"])
-    invocation = build req "GET"
-    res = invoke invocation
+    builder = request webTarget
+    acceptMediaType builder [WILDCARD_TYPE]
+    invocation = buildGet builder
+    response = syncInvoke invocation
+    print $ statusCodeOf response
+    print $ statusMessageOf response
+    res = readEntity response

     close httpClient
     res
 
     close httpClient
     res
 

+postMultiPartExample :: String -> [File] -> <Proc, Exception> String
+postMultiPartExample uri files = do  
+    httpClient = buildClient clientBuilder
+    webTarget = target httpClient uri
+    builder = request webTarget
+    acceptMediaType builder [WILDCARD_TYPE]
+    mp = formDataMultiPart
+    addBodyPart mp $ formDataBodyPart "Name" "Test" $ withCharset TEXT_PLAIN_TYPE "utf-8"
+    iterI (\i f ->
+      addBodyPart mp $ fileDataBodyPart ("file" + show i) f APPLICATION_OCTET_STREAM_TYPE
+    ) files
+    invocation = buildPost builder $ entity mp MULTIPART_FORM_DATA_TYPE
+    response = syncInvoke invocation
+    print $ statusCodeOf response
+    print $ statusMessageOf response
+    res = readEntity response
+    close httpClient
+    res
+
+postFileExample :: String -> File -> <Proc, Exception> String
+postFileExample uri f = do  
+    httpClient = buildClient clientBuilder
+    webTarget = target httpClient uri
+    builder = request webTarget
+    acceptMediaType builder [WILDCARD_TYPE]
+    mp = formDataMultiPart
+    invocation = buildPost builder $ entity f APPLICATION_OCTET_STREAM_TYPE
+    response = syncInvoke invocation
+    print $ statusCodeOf response
+    print $ statusMessageOf response
+    res = readEntity response
+    close httpClient
+    res
+
+postFileAsyncExample :: String -> File -> <Proc, Exception> ()
+postFileAsyncExample uri f = do  
+    httpClient = buildClient clientBuilder
+    webTarget = target httpClient uri
+    builder = request webTarget
+    acceptMediaType builder [WILDCARD_TYPE]
+    mp = formDataMultiPart
+    invocation = buildPost builder $ entity f APPLICATION_OCTET_STREAM_TYPE
+    f = asyncInvoke invocation 
+      (\response -> do
+        print $ statusCodeOf response
+        print $ statusMessageOf response
+        catch (do
+          content = ((readEntity response) :: String)
+          print $ length content
+        ) (\(t :: Throwable) -> print $ show t) 
+        close httpClient
+        ()
+      )
+      (\throwable -> do
+        print $ show throwable
+        close httpClient
+        ()
+      )
+    print $ isFutureDone f
+*/
\ No newline at end of file

diff --git a/bundles/org.simantics.scl.rest/scl/HTTP/Form.scl b/bundles/org.simantics.scl.rest/scl/HTTP/Form.scl
new file mode 100644 (file)
index 0000000..930a1e1
--- /dev/null
+++ b/bundles/org.simantics.scl.rest/scl/HTTP/Form.scl
@@ -0,0 +1,6 @@
+importJava "javax.ws.rs.core.Form" where
+    data Form
+    
+    @JavaName "<init>"
+    form :: <Proc> Form
+    param :: Form -> String -> String -> <Proc> ()
\ No newline at end of file

diff --git a/bundles/org.simantics.scl.rest/scl/HTTP/MediaType.scl b/bundles/org.simantics.scl.rest/scl/HTTP/MediaType.scl
new file mode 100644 (file)
index 0000000..95be994
--- /dev/null
+++ b/bundles/org.simantics.scl.rest/scl/HTTP/MediaType.scl
@@ -0,0 +1,19 @@
+importJava "javax.ws.rs.core.MediaType" where
+    data MediaType
+    
+    WILDCARD_TYPE :: MediaType
+    APPLICATION_XML_TYPE :: MediaType
+    APPLICATION_ATOM_XML_TYPE :: MediaType
+    APPLICATION_XHTML_XML_TYPE :: MediaType
+    APPLICATION_SVG_XML_TYPE :: MediaType
+    APPLICATION_JSON_TYPE :: MediaType
+    APPLICATION_FORM_URLENCODED_TYPE :: MediaType
+    MULTIPART_FORM_DATA_TYPE :: MediaType
+    APPLICATION_OCTET_STREAM_TYPE :: MediaType
+    TEXT_PLAIN_TYPE :: MediaType
+    TEXT_XML_TYPE :: MediaType
+    TEXT_HTML_TYPE :: MediaType
+    
+    @JavaName valueOf
+    mediaType :: String -> MediaType
+    withCharset :: MediaType -> String -> <Proc> MediaType
\ No newline at end of file

diff --git a/bundles/org.simantics.scl.rest/scl/HTTP/MultiPart.scl b/bundles/org.simantics.scl.rest/scl/HTTP/MultiPart.scl
new file mode 100644 (file)
index 0000000..44cb307
--- /dev/null
+++ b/bundles/org.simantics.scl.rest/scl/HTTP/MultiPart.scl
@@ -0,0 +1,43 @@
+import "File"
+import "Stream"
+import "HTTP/MediaType"
+import "JavaBuiltin" as Java
+
+importJava "org.glassfish.jersey.media.multipart.MultiPart" where
+    data MultiPart
+    
+    @JavaName "<init>"
+    multiPart :: MediaType -> <Proc> MultiPart
+    
+    @JavaName bodyPart
+    addBodyPart :: MultiPart -> BodyPart -> <Proc> MultiPart
+
+importJava "org.glassfish.jersey.media.multipart.BodyPart" where
+    data BodyPart
+    
+    @JavaName "<init>"
+    bodyPart :: a -> MediaType -> <Proc> BodyPart 
+
+importJava "org.glassfish.jersey.media.multipart.FormDataBodyPart" where
+    data FormDataBodyPart
+    
+    @JavaName "<init>"
+    formDataBodyPart :: String -> a -> MediaType -> <Proc> BodyPart
+
+importJava "org.glassfish.jersey.media.multipart.file.FileDataBodyPart" where
+    data FileDataBodyPart
+    
+    @JavaName "<init>"
+    fileDataBodyPart :: String -> File -> MediaType -> <Proc> BodyPart
+
+importJava "org.glassfish.jersey.media.multipart.file.StreamDataBodyPart" where
+    data StreamDataBodyPart
+    
+    @JavaName "<init>"
+    streamDataBodyPart :: String -> InputStream -> String -> MediaType -> <Proc> BodyPart
+
+multiPartAsBodyPart :: MultiPart -> BodyPart
+multiPartAsBodyPart mp = Java.unsafeCoerce mp
+
+formDataMultiPart :: <Proc> MultiPart
+formDataMultiPart = multiPart MULTIPART_FORM_DATA_TYPE
\ No newline at end of file

diff --git a/bundles/org.simantics.scl.rest/src/org/simantics/scl/rest/HttpClientUtils.java b/bundles/org.simantics.scl.rest/src/org/simantics/scl/rest/HttpClientUtils.java
new file mode 100644 (file)
index 0000000..dfdbf5b
--- /dev/null
+++ b/bundles/org.simantics.scl.rest/src/org/simantics/scl/rest/HttpClientUtils.java
@@ -0,0 +1,57 @@
+package org.simantics.scl.rest;
+
+import java.util.concurrent.Future;
+
+import javax.ws.rs.client.Client;
+import javax.ws.rs.client.ClientBuilder;
+import javax.ws.rs.client.Invocation;
+import javax.ws.rs.client.InvocationCallback;
+import javax.ws.rs.core.Configuration;
+import javax.ws.rs.core.Response;
+
+import org.glassfish.jersey.client.ClientConfig;
+import org.glassfish.jersey.media.multipart.MultiPartFeature;
+import org.simantics.scl.runtime.SCLContext;
+import org.simantics.scl.runtime.function.Function1;
+import org.simantics.scl.runtime.tuple.Tuple0;
+
+public class HttpClientUtils {
+    
+    public static Client buildClient(ClientBuilder clientBuilder) {
+        final ClientConfig clientConfig = new ClientConfig();
+        clientConfig.register(MultiPartFeature.class);
+        return ClientBuilder.newBuilder().withConfig((Configuration) clientConfig).build();
+    }
+    
+    public static String statusMessageOf(Response response) {
+        return response.getStatusInfo().getReasonPhrase();
+    }
+    
+    public static Future<Response> asyncInvoke(Invocation invocation, Function1<Response, Tuple0> responseCallback, Function1<Throwable, Tuple0> failureCallback) {
+        SCLContext context = SCLContext.createDerivedContext();
+        
+        return invocation.submit(new InvocationCallback<Response>() {
+
+            @Override
+            public void completed(Response response) {
+                SCLContext.push(context);
+                try {
+                    responseCallback.apply(response);
+                } finally {
+                    SCLContext.pop();
+                }
+            }
+            
+            @Override
+            public void failed(Throwable throwable) {
+                SCLContext.push(context);
+                try {
+                    failureCallback.apply(throwable);
+                } finally {
+                    SCLContext.pop();
+                }
+                
+            }
+        });
+    }
+}