-import "Map" as Map
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
- 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
- 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
+ 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
- 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
-
- @JavaName build
+
+importJava "org.simantics.scl.rest.HttpClientUtils" where
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
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
- 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
+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
--- /dev/null
+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();
+ }
+
+ }
+ });
+ }
+}
Code Review / simantics / platform.git / commitdiff