WIP Support configurable client deadlines

DESCRIPTION

@@ -19,4 +19,4 @@ LinkingTo: Rcpp
 SystemRequirements: 
     grpc (>= 4.0.0)
     protobuf
-RoxygenNote: 6.0.1
+RoxygenNote: 7.1.0

R/RcppExports.R

@@ -1,8 +1,8 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
-fetch <- function(server, method, requestArg, metadata) {
-    .Call('_grpc_fetch', PACKAGE = 'grpc', server, method, requestArg, metadata)
+fetch <- function(server, method, requestArg, metadata, UseTLS, CertPath, AccessToken, ClientDeadline) {
+    .Call('_grpc_fetch', PACKAGE = 'grpc', server, method, requestArg, metadata, UseTLS, CertPath, AccessToken, ClientDeadline)
 }
 
 #' Check grpc version
@@ -12,7 +12,7 @@ grpc_version <- function() {
     .Call('_grpc_grpc_version', PACKAGE = 'grpc')
 }
 
-run <- function(target, hoststring, hooks) {
-    .Call('_grpc_run', PACKAGE = 'grpc', target, hoststring, hooks)
+run <- function(target, hoststring, hooks, UseTLS, CertPath, AccessToken) {
+    .Call('_grpc_run', PACKAGE = 'grpc', target, hoststring, hooks, UseTLS, CertPath, AccessToken)
 }
 

R/client.R

@@ -1,25 +1,62 @@
-#' Build a client handle
-#' 
+#' Build a client handle 
 #' @param stubs the stub of the service
 #' @param channel what to connect to
 #' @return client handle
 #' @importFrom RProtoBuf P serialize read new
 #' @export
-grpc_client <- function(impl, channel) {
-
-
-  client_functions <- lapply(impl, function(fn)
-    {
-      RequestDescriptor <- P(fn[["RequestType"]]$proto)
-      ResponseDescriptor <- P(fn[["ResponseType"]]$proto)
-
-      list(
-        call = function(x, metadata=character(0)) read(ResponseDescriptor, fetch(channel, fn$name, serialize(x, NULL), metadata)),
-        build = function(...) new(RequestDescriptor, ...)
-      )
-    })
-
+grpc_client <- function(impl, channel)
+{
 
+  UseTLS <- getOption("UseTLS", default = TRUE)
+  CertPath <- getOption("CertPath", default = NULL)
+  AccessToken <- getOption("AccessToken", default = NULL)
+  ClientDeadline <- getOption("ClientDeadline", default = 5)
+
+  client_functions <- lapply(impl, 
+  function(fn)
+  {
+	  RequestDescriptor   <- P(fn[["RequestType"]]$proto)
+	  ResponseDescriptor  <- P(fn[["ResponseType"]]$proto)
+	  stream_bool <- fn[["ResponseType"]]$stream
+	  message <- list(
+		  call = function(x, metadata=character(0)) 
+		  {
+			  if(stream_bool) {
+				  i <- 1
+				  List_messages <- list()
+				  while(1) {
+					  message <- read(
+						  ResponseDescriptor, 
+						  fetch(channel, fn$name, serialize(x, NULL), metadata, UseTLS, CertPath, AccessToken, ClientDeadline)
+						  )
+
+					  if(as.list(message) == '')
+						break;
+
+					  List_messages[[i]] <- message
+					  i <- i + 1
+					  }
+				}
+
+			  else {
+				List_messages <- read(
+					ResponseDescriptor, 
+					fetch(channel, fn$name, serialize(x, NULL), metadata, UseTLS, CertPath, AccessToken, ClientDeadline)
+					)
+				}
+
+				List_messages
+            },
+
+            build = function(...) 
+            {
+              new(RequestDescriptor, ...)
+            }
+        )
+
+		message
+	}
+  )
 
   client_functions
-}
+}

R/server.R

@@ -11,27 +11,43 @@
 #' @seealso \code{\link{grpc_default_hooks}}
 start_server <- function(impl, channel, hooks = grpc_default_hooks()) {
 
+  UseTLS <- getOption("UseTLS", default = TRUE)
+  CertPath <- getOption("CertPath", default = NULL)
+  AccessToken <- getOption("AccessToken", default = NULL)
+
   if (!is.null(hooks$exit) & is.function(hooks$exit)) {
     on.exit(hooks$exit())
   }
 
-  server_functions <- lapply(impl, function(fn){
+  serialFun <- function(fn) {
+
     descriptor <- P(fn[["RequestType"]]$proto)
 
     f <- structure(fn$f,
                    RequestType  = fn[["RequestType"]],
                    ResponseType = fn[["ResponseType"]])
 
     function(x) serialize(f(read(descriptor, x)), NULL)
-  })
+  }
+
+  streamFun <- function(fn) {
+    descriptor <- fn[["ResponseType"]]$stream
+  }
+
+  stream_bool <- lapply(impl, streamFun)
+  server_functions <- lapply(impl, serialFun)
+
+  checkAuthCallback <- function(token) {
+    token == AccessToken
+  }
 
   names(server_functions) <- vapply(impl, function(x)x$name, NA_character_)
+  names(stream_bool) <- vapply(impl, function(x)x$name, NA_character_)
 
-  run(server_functions, channel, hooks)
+  run(server_functions, channel, hooks, UseTLS, CertPath, checkAuthCallback, stream_bool)
   invisible(NULL)
 }
 
-
 #' Construct a new ProtoBuf of ResponseType
 #'
 #' @param ... threaded through to the ProtoBuf constructor
@@ -40,6 +56,11 @@ start_server <- function(impl, channel, hooks = grpc_default_hooks()) {
 #'
 #' @export
 #' @importFrom RProtoBuf P new
-newResponse <- function(..., WFUN=sys.function(-1)){
-  new(P(attr(WFUN, "ResponseType")$proto), ...)
+newResponse <- function(..., WFUN=sys.function(-1)) {
+
+  response <- new(P(attr(WFUN, "ResponseType")$proto), ...)
+
+  # Serialize the response
+  serializedResponse = serialize(response, NULL)
+  streamMessage(serializedResponse)
 }

demo/hello_Client_Streaming.R

@@ -0,0 +1,24 @@
+#' Example gRPC client
+#'
+#' Sends a message with a name and returns a message greeting the name.
+#' @references \url{https://github.com/grpc/grpc/tree/master/examples/cpp/helloworld}
+
+library(grpc)
+
+
+spec <- system.file('examples/helloworld.proto', package = 'grpc')  
+impl <- read_services(spec)
+
+options(UseTLS = FALSE)
+options(CertPath = "/home/shehab/Dropbox/gRPC/Certificates/")
+options(AccessToken = "Bearer Token Shehab and Neal")
+options(ClientDeadline = 10)
+
+client <- grpc_client(impl, "localhost:50051")
+
+everything <- client$SayEverything$build(name='Shehab')
+queue <- client$SayEverything$call(everything)
+
+for (message in queue) {
+	print(as.list(message))
+}

demo/hello_Server_Streaming.R

@@ -0,0 +1,38 @@
+#' Example gRPC service
+#'
+#' Reads a message with a name and returns a message greeting the name.
+#' @references \url{https://github.com/grpc/grpc/tree/master/examples/cpp/helloworld}
+
+library(grpc)
+
+## reading the service definitions
+spec <- system.file('examples/helloworld.proto', package = 'grpc')
+
+impl <- read_services(spec)
+
+options(UseTLS = FALSE)
+options(CertPath = "/home/shehab/Dropbox/gRPC/Certificates/")
+options(AccessToken = "Bearer Token Shehab and Neal")
+
+impl$SayHello$f <- function(request){
+  newResponse(message = paste('Hello,', request$name))
+}
+
+impl$SayThanks$f <- function(request){
+  newResponse(message = paste('Thanks,', request$name))
+}
+
+impl$SayBye$f <- function(request){
+  newResponse(message = paste('Bye,', request$name))
+}
+
+impl$SayEverything$f <- function(request){
+  newResponse(message = paste('Your name is ', request$name))
+  newResponse(message = paste('Hello,', request$name))
+  newResponse(message = paste('I hope you are enjoying your day,', request$name))
+  newResponse(message = paste('Thanks,', request$name))
+  newResponse(message = paste('Bye,', request$name))
+}
+
+## actually running the service handlers
+start_server(impl, "0.0.0.0:50051")

demo/helloclient.R

@@ -8,25 +8,31 @@ library(grpc)
 
 spec <- system.file('examples/helloworld.proto', package = 'grpc')  
 impl <- read_services(spec)
+
+options(UseTLS = TRUE)
+options(CertPath = "/home/shehab/Dropbox/gRPC/Certificates/")
+options(AccessToken = "Bearer Token Shehab and Neal")
+options(ClientDeadline = 10)
+
 client <- grpc_client(impl, "localhost:50051")
 
 
 for(who in c("Neal", "Gergely", "Jay")){
     hello <- client$SayHello$build(name=who)
     message <- client$SayHello$call(hello)
 
-    print(message)
+    #print(message)
     print(as.list(message))
 
     thanks <- client$SayThanks$build(name=who)
-    message <- client$SayThanks$callWithMetadata(thanks, c("key1", "val1"))
+    message <- client$SayThanks$call(thanks, c("authorization", "Bearer Token Shehab and Neal"))
 
-    print(message)
+    #print(message)
     print(as.list(message))
 
     bye <- client$SayBye$build(name=who)
     message <- client$SayBye$call(bye)
 
-    print(message)
+    #print(message)
     print(as.list(message))
 }

demo/helloserver.R

@@ -10,6 +10,10 @@ spec <- system.file('examples/helloworld.proto', package = 'grpc')
 
 impl <- read_services(spec)
 
+options(UseTLS = TRUE)
+options(CertPath = "/home/shehab/Dropbox/gRPC/Certificates/")
+options(AccessToken = "Bearer Token Shehab and Neal")
+
 impl$SayHello$f <- function(request){
   newResponse(message = paste('Hello,', request$name))
 }
@@ -24,4 +28,3 @@ impl$SayBye$f <- function(request){
 
 ## actually running the service handlers
 start_server(impl, "0.0.0.0:50051")
-

src/RcppExports.cpp

@@ -6,16 +6,20 @@
 using namespace Rcpp;
 
 // fetch
-RawVector fetch(CharacterVector server, CharacterVector method, RawVector requestArg, CharacterVector metadata);
-RcppExport SEXP _grpc_fetch(SEXP serverSEXP, SEXP methodSEXP, SEXP requestArgSEXP, SEXP metadataSEXP) {
+RawVector fetch(CharacterVector server, CharacterVector method, RawVector requestArg, CharacterVector metadata, bool useTLS, CharacterVector CertPath, CharacterVector AccessToken, int ClientDeadline);
+RcppExport SEXP _grpc_fetch(SEXP serverSEXP, SEXP methodSEXP, SEXP requestArgSEXP, SEXP metadataSEXP, SEXP useTLSSEXP, SEXP CertPathSEXP, SEXP AccessTokenSEXP, SEXP ClientDeadlineSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
     Rcpp::traits::input_parameter< CharacterVector >::type server(serverSEXP);
     Rcpp::traits::input_parameter< CharacterVector >::type method(methodSEXP);
     Rcpp::traits::input_parameter< RawVector >::type requestArg(requestArgSEXP);
     Rcpp::traits::input_parameter< CharacterVector >::type metadata(metadataSEXP);
-    rcpp_result_gen = Rcpp::wrap(fetch(server, method, requestArg, metadata));
+    Rcpp::traits::input_parameter< bool >::type useTLS(useTLSSEXP);
+    Rcpp::traits::input_parameter< CharacterVector >::type CertPath(CertPathSEXP);
+    Rcpp::traits::input_parameter< CharacterVector >::type AccessToken(AccessTokenSEXP);
+    Rcpp::traits::input_parameter< int >::type ClientDeadline(ClientDeadlineSEXP);
+    rcpp_result_gen = Rcpp::wrap(fetch(server, method, requestArg, metadata, useTLS, CertPath, AccessToken, ClientDeadline));
     return rcpp_result_gen;
 END_RCPP
 }
@@ -30,15 +34,18 @@ BEGIN_RCPP
 END_RCPP
 }
 // run
-List run(List target, CharacterVector hoststring, List hooks);
-RcppExport SEXP _grpc_run(SEXP targetSEXP, SEXP hoststringSEXP, SEXP hooksSEXP) {
+List run(List target, CharacterVector hoststring, List hooks, bool useTLS, CharacterVector CertPath, CharacterVector AccessToken);
+RcppExport SEXP _grpc_run(SEXP targetSEXP, SEXP hoststringSEXP, SEXP hooksSEXP, SEXP useTLSSEXP, SEXP CertPathSEXP, SEXP AccessTokenSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
     Rcpp::traits::input_parameter< List >::type target(targetSEXP);
     Rcpp::traits::input_parameter< CharacterVector >::type hoststring(hoststringSEXP);
     Rcpp::traits::input_parameter< List >::type hooks(hooksSEXP);
-    rcpp_result_gen = Rcpp::wrap(run(target, hoststring, hooks));
+    Rcpp::traits::input_parameter< bool >::type useTLS(useTLSSEXP);
+    Rcpp::traits::input_parameter< CharacterVector >::type CertPath(CertPathSEXP);
+    Rcpp::traits::input_parameter< CharacterVector >::type AccessToken(AccessTokenSEXP);
+    rcpp_result_gen = Rcpp::wrap(run(target, hoststring, hooks, useTLS, CertPath, AccessToken));
     return rcpp_result_gen;
 END_RCPP
 }

src/TLS/Generated.sh

@@ -0,0 +1,16 @@
+rm *.pem
+
+# 1. Generate CA's private key and self-signed certificate
+openssl req -x509 -newkey rsa:4096 -days 365 -nodes -keyout ca-key.pem -out ca-cert.pem -subj "/C=EG/ST=CairoEG/L=Cairo/O=GSoC/OU=CerAuth/CN=Cert/[email protected]"
+
+# 2. Generate web server's private key and certificate signing request (CSR)
+openssl req -newkey rsa:4096 -nodes -keyout server-key.pem -out server-req.pem -subj "/C=EG/ST=AlexEG/L=Alex/O=GSoC/OU=Server/CN=Server/[email protected]"
+
+# 3. Use CA's private key to sign web server's CSR and get back the signed certificate
+openssl x509 -req -in server-req.pem -days 60 -CA ca-cert.pem -CAkey ca-key.pem -CAcreateserial -out server-cert.pem -extfile server-ext.cnf
+
+# 4. Generate client's private key and certificate signing request (CSR)
+openssl req -newkey rsa:4096 -nodes -keyout client-key.pem -out client-req.pem -subj "/C=FR/ST=Alsace/L=Strasbourg/O=PC Client/OU=Computer/CN=Client/[email protected]"
+
+# 5. Use CA's private key to sign client's CSR and get back the signed certificate
+openssl x509 -req -in client-req.pem -days 60 -CA ca-cert.pem -CAkey ca-key.pem -CAcreateserial -out client-cert.pem

src/TLS/TokenValue.txt

@@ -0,0 +1 @@
+Bearer Token Shehab and Neal

src/TLS/ca-cert.pem

@@ -0,0 +1,34 @@
+-----BEGIN CERTIFICATE-----
+MIIF2TCCA8GgAwIBAgIUMS+szswcHFErLoEzUBoSFd+c8mQwDQYJKoZIhvcNAQEL
+BQAwfDELMAkGA1UEBhMCRUcxEDAOBgNVBAgMB0NhaXJvRUcxDjAMBgNVBAcMBUNh
+aXJvMQ0wCwYDVQQKDARHU29DMRAwDgYDVQQLDAdDZXJBdXRoMQ0wCwYDVQQDDARD
+ZXJ0MRswGQYJKoZIhvcNAQkBFgxjYUBnbWFpbC5jb20wHhcNMjAwODIzMDMyNzAx
+WhcNMjEwODIzMDMyNzAxWjB8MQswCQYDVQQGEwJFRzEQMA4GA1UECAwHQ2Fpcm9F
+RzEOMAwGA1UEBwwFQ2Fpcm8xDTALBgNVBAoMBEdTb0MxEDAOBgNVBAsMB0NlckF1
+dGgxDTALBgNVBAMMBENlcnQxGzAZBgkqhkiG9w0BCQEWDGNhQGdtYWlsLmNvbTCC
+AiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAN2jxex7Q7xQplF1sjsQcluD
+4fiuyUVite0/P3x9YwwmYyH+9Kfgfr6XDFm73JGbu1yEkNpcsH0QoFNwuofWh8VV
+v779qh2JDhgLHUmhFAeIfX2PRxKlne5WEYlavrRXOZfnXp6L9yWZGbJ5PT77yrd/
+2m+HPYPTdbfeLvo953tXKBc+1sIuAYgTY7SgWB9HnCNSLl7prdyKP5gTLXZ2ZJG4
+3ilG2+o6WC7y7HHVKJAlDCajm+haAOmfoiEcMMiD4ROTBeVpyGveVJYPkOokmAgt
+ZJ829Vg3v8b35UWGoC31D6UsOVBU80tnjGGqKnAuolhGcThh8O+zySeMYGiEuCqc
+NaSaf752cSC1ZmmxpuxPXpTpG+mbrK8VcoPV/2Aw268obUc/xij6F4fzsaynWpS4
+rr60pcFGhvCoAJFHCrJpZubhUjCOLB4R2SR0ZPTWEjfelaTnUsdAK42i7clf9ey0
+AUNdE4/7Wsg5P0CrWBMyUHN07TFwuPznIn/i0yLcYSOgmg3BBzoqFnxpWWd+AvHR
+L3/Nr/ffqpWGSwbahpCbvAm600BjIpMCtmpvcW0ozkH2gT2R9Iq0lwgd/NtF2ntG
+QkcJZBqbbzLOD+BxxDAQTy6O4cQ755jASFF7Y/VQysOj8uWEmEXikfthhFcbiZSZ
+srrO6tz4RuBFCrYbHaWvAgMBAAGjUzBRMB0GA1UdDgQWBBTA6JHuSLi59H4MYX6r
+dZ/Hdmbm9jAfBgNVHSMEGDAWgBTA6JHuSLi59H4MYX6rdZ/Hdmbm9jAPBgNVHRMB
+Af8EBTADAQH/MA0GCSqGSIb3DQEBCwUAA4ICAQC77fpr71FiWe7foraaB/xbr5Ll
+1wh5tg2HpuvZZC78GO4WYHmDInsG3KX3/W5Ojc3BjtQFyPWDE5Riwe0t5aM/EsOt
+iYAuD6qtaDmB4slXTISGujRkutPYraPEXDpfE/NUuw6yfl05qU1pCYQYoiF6yXBh
+Q9E65xHb1M1nLM2kebT6cxKhdyYrz/ivbSD9Z4j9t+wQSLKH1bRIjtSvIE0jOySA
+SmpayhwrNcuyDZDW/FaQ/pjHrYscqPKIs1FMyHJdja+/TDrkRuugQAaFFVdiu2NM
+yUm9rBdA/ota2HTDg8CLUbWcyxvuXgJ2VU/7RVC3aOPbqv1dR9LmcEhiQlbTSM7k
+8HAmsfRjzKhQnGvYPQuwoaiSLxUx1WrQU6WOUP5bYV9Vdyp2xNFbxD893Ixsfwww
+1mFh2ONrPThJk1uMYFBwfVRcdW4UyyG1XK56nkgyvcssY69TKV1IdXyXkJBOWCJ3
+eSl217Qp5hinSMfZhCjA54uYFcEx5zDFuDF2FJ3N39Wcpunkw7Imz5JnEl+P3dhD
+NYKUZD547zCpXJCQnQ5H5IxO4tgY2sUY5FfCWzUjE3EYOINQafH/DSJhHLkN1Gv3
+YRVyBse1Fr3skdR3Y5IbaXz+mwlK5g3NdTcKLuDff8NbWJ7jyaKIampFPKQiOQ60
+pcDFhM+qUu8DWVbsPw==
+-----END CERTIFICATE-----

src/TLS/ca-cert.srl

@@ -0,0 +1 @@
+7F33FEC39385275088DF073E9DBD3A32AE20FF1C