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