]> gerrit.simantics Code Review - simantics/platform.git/blob - bundles/org.simantics.scl.rest/scl/HTTP/Client.scl
Added transient caching for BrowseContext construction
[simantics/platform.git] / bundles / org.simantics.scl.rest / scl / HTTP / Client.scl
1 import "Vector"
2 import "File"
3 import "HTTP/Form"
4 import "HTTP/MultiPart"
5 import "HTTP/MediaType"
6 import "Future"
7
8 type ResponseHandler = Response -> <Proc> ()
9 type FailureHandler = Throwable -> <Proc> ()
10
11 NO_RESPONSE_HANDLER = (\response -> ()) :: ResponseHandler 
12 NO_FAILURE_HANDLER = (\failure -> ()) :: FailureHandler 
13
14 importJava "javax.ws.rs.client.Invocation" where
15     data Invocation
16
17     @JavaName invoke
18     syncInvoke :: Invocation -> <Proc, Exception> Response
19
20 importJava "javax.ws.rs.core.Response" where
21     data Response
22     @JavaName getStatus
23     statusCodeOf :: Response -> <Proc> Integer
24     @Private
25     @JavaName readEntity
26     readEntity_ :: Response -> Class a -> <Proc, Exception> a
27     @JavaName getHeaderString
28     possibleHeaderOf :: Response -> String -> <Proc> Maybe String
29
30 readEntity :: VecComp a => Response -> <Proc, Exception> a
31 readEntity response = readEntity_ response classObject
32
33 importJava "javax.ws.rs.client.Invocation$Builder" where
34     data Builder
35     
36     header :: Builder -> String -> String -> <Proc> Builder
37     @private
38     @JavaName accept
39     acceptMediaType_ :: Builder -> Vector MediaType -> <Proc> Builder
40     @private
41     @JavaName acceptEncoding
42     acceptEncoding_ :: Builder -> Vector String -> <Proc> Builder
43     @private
44     @JavaName acceptLanguage
45     acceptLanguage_ :: Builder -> Vector String -> <Proc> Builder
46     cookie :: Builder -> String -> String -> <Proc> Builder
47     build :: Builder -> String -> <Proc> Invocation
48     buildGet :: Builder -> <Proc> Invocation
49     buildPost :: Builder -> Entity -> <Proc> Invocation
50     buildDelete :: Builder -> <Proc> Invocation
51     buildPut :: Builder -> Entity -> <Proc> Invocation
52
53 acceptMediaType :: Builder -> [MediaType] -> <Proc> Builder
54 acceptMediaType builder mediaTypes =
55     acceptMediaType_ builder $ vector mediaTypes
56
57 acceptEncoding :: Builder -> [String] -> <Proc> Builder
58 acceptEncoding builder encodings =
59     acceptEncoding_ builder $ vector encodings
60
61 acceptLanguage :: Builder -> [String] -> <Proc> Builder
62 acceptLanguage builder languages =
63     acceptEncoding_ builder $ vector languages
64
65 importJava "javax.ws.rs.client.WebTarget" where
66     data WebTarget
67
68     path :: WebTarget -> String -> <Proc> WebTarget
69     request :: WebTarget -> <Proc> Builder
70
71 importJava "javax.ws.rs.client.ClientBuilder" where
72     data ClientBuilder
73     
74     @JavaName newBuilder
75     clientBuilder :: <Proc> ClientBuilder
76
77 importJava "org.simantics.scl.rest.HttpClientUtils" where
78     buildClient :: ClientBuilder -> <Proc> Client
79     statusMessageOf :: Response -> <Proc> String
80     asyncInvoke :: Invocation -> ResponseHandler -> FailureHandler -> <Proc> Future Response
81     trustAllClientBuilder :: <Proc> ClientBuilder
82     onReadProgress :: WebTarget -> (Long -> <Proc> ()) -> <Proc> ()
83     onWriteProgress :: WebTarget -> (Long -> <Proc> ()) -> <Proc> ()
84     possibleContentLengthOf :: Response -> <Proc> Maybe Long
85
86 importJava "javax.ws.rs.client.Entity" where
87     data Entity
88     
89     @JavaName form
90     formEntity :: Form -> <Proc> Entity
91     entity :: a -> MediaType -> <Proc> Entity
92
93 importJava "javax.ws.rs.client.Client" where
94     data Client
95
96     target :: Client -> String -> <Proc> WebTarget
97     close :: Client -> <Proc> ()
98
99 /*
100 Example usage:
101
102 getExample :: String -> <Proc, Exception> String
103 getExample uri = do
104     httpClient = buildClient clientBuilder
105     webTarget = target httpClient uri
106     builder = request webTarget
107     acceptMediaType builder [WILDCARD_TYPE]
108     invocation = buildGet builder
109     response = syncInvoke invocation
110     print $ statusCodeOf response
111     print $ statusMessageOf response
112     res = readEntity response
113     close httpClient
114     res
115
116 postMultiPartExample :: String -> [File] -> <Proc, Exception> String
117 postMultiPartExample uri files = do  
118     httpClient = buildClient clientBuilder
119     webTarget = target httpClient uri
120     builder = request webTarget
121     acceptMediaType builder [WILDCARD_TYPE]
122     mp = formDataMultiPart
123     addBodyPart mp $ formDataBodyPart "Name" "Test" $ withCharset TEXT_PLAIN_TYPE "utf-8"
124     iterI (\i f ->
125       addBodyPart mp $ fileDataBodyPart ("file" + show i) f APPLICATION_OCTET_STREAM_TYPE
126     ) files
127     invocation = buildPost builder $ entity mp MULTIPART_FORM_DATA_TYPE
128     response = syncInvoke invocation
129     print $ statusCodeOf response
130     print $ statusMessageOf response
131     res = readEntity response
132     close httpClient
133     res
134
135 postFileExample :: String -> File -> <Proc, Exception> String
136 postFileExample uri f = do  
137     httpClient = buildClient clientBuilder
138     webTarget = target httpClient uri
139     builder = request webTarget
140     acceptMediaType builder [WILDCARD_TYPE]
141     invocation = buildPost builder $ entity f APPLICATION_OCTET_STREAM_TYPE
142     response = syncInvoke invocation
143     print $ statusCodeOf response
144     print $ statusMessageOf response
145     res = readEntity response
146     close httpClient
147     res
148
149 postFileAsyncExample :: String -> File -> <Proc, Exception> ()
150 postFileAsyncExample uri f = do  
151     httpClient = buildClient clientBuilder
152     webTarget = target httpClient uri
153     builder = request webTarget
154     acceptMediaType builder [WILDCARD_TYPE]
155     mp = formDataMultiPart
156     invocation = buildPost builder $ entity f APPLICATION_OCTET_STREAM_TYPE
157     f = asyncInvoke invocation 
158       (\response -> do
159         print $ statusCodeOf response
160         print $ statusMessageOf response
161         catch (do
162           content = ((readEntity response) :: String)
163           print $ length content
164         ) (\(t :: Throwable) -> print $ show t) 
165         close httpClient
166         ()
167       )
168       (\throwable -> do
169         print $ show throwable
170         close httpClient
171         ()
172       )
173     print $ isFutureDone f
174 */