Improvements to HTTP client SCL API

[simantics/platform.git] / bundles / org.simantics.scl.rest / scl / HTTP / Client.scl

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 "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
@@ -41,13 +90,80 @@ importJava "javax.ws.rs.client.Client" where
     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