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 */