stibee.R

library(curl)
library(httr)
library(dplyr)
library(purrr)
library(tictoc)
tar <- "http://work-sample-tests.stibee.com:7777"

tem <- modify_url(tar, path = "hello")

POST(tem, body = list(id = "[email protected]")) %>%
  content -> auth_key

test <- modify_url(tar, path = "test1")

build_h <- function() {
  h <- new_handle()
  handle_setopt(h, customrequest = "POST")
  handle_setform(h, .list = list(data = as.character(rnorm(1))))
  handle_setheaders(h, "AccessToken" = auth_key)
  return(h)
}

build_h_start <- function() {
  h_start <- new_handle()
  handle_setopt(h_start, customrequest = "PUT")
  handle_setform(h_start, .list = list(flag = "START"))
  handle_setheaders(h_start, "AccessToken" = auth_key)
  return(h_start)
}

pool <- new_pool(total_con = 100, host_con = 100)

cb <- function(req) {
  cat(rawToChar(req$content), ",")
}

res <-
  replicate(10100,
            curl_fetch_multi(
              test,
              pool = pool,
              done = cb,
              handle = build_h()
            ))
print(pool)
tic()
print(rawToChar(curl_fetch_memory(test, handle = build_h_start())$content))
out <- multi_run(pool = pool)
toc()



test <- modify_url(tar, path = "test2")

build_h_start <- function() {
  h_start <- new_handle()
  handle_setopt(h_start, customrequest = "PUT")
  handle_setform(h_start, .list = list(flag = "START"))
  handle_setheaders(h_start, "AccessToken" = auth_key)
  return(h_start)
}

build_h <- function() {
  h <- new_handle()
  handle_setopt(h, customrequest = "POST")
  handle_setopt(h, timeout = 5)
  handle_setform(h, .list = list(data = as.character(rnorm(1))))
  handle_setheaders(h, "AccessToken" = auth_key)
  return(h)
}

cb <- function(req) {
  cat(rawToChar(req$content), ",")
}

pool <- new_pool(total_con = 1000, host_con = 1000)

res <-
  replicate(1000,
            curl_fetch_multi(
              test,
              pool = pool,
              done = cb, 
              handle = build_h()
            ))
print(pool)
print(rawToChar(curl_fetch_memory(test, handle = build_h_start())$content))
out <- multi_run(pool = pool)

build_h_end <- function() {
  h_start <- new_handle()
  handle_setopt(h_start, customrequest = "PUT")
  handle_setform(h_start, .list = list(flag = "END",
                                       data = as.character(out$success)))
  handle_setheaders(h_start, "AccessToken" = auth_key)
  return(h_start)
}

tem <- rawToChar(curl_fetch_memory(test, handle = build_h_end())$content)
Encoding(tem)<-"UTF-8"
tem




test <- modify_url(tar, path = "test3")

build_h_start <- function() {
  h_start <- new_handle()
  handle_setopt(h_start, customrequest = "PUT")
  handle_setform(h_start, .list = list(flag = "START"))
  handle_setheaders(h_start, "AccessToken" = auth_key)
  return(h_start)
}

build_h <- function() {
  h <- new_handle()
  handle_setopt(h, customrequest = "GET")
  handle_setheaders(h, "AccessToken" = auth_key)
  return(h)
}

build_h_report <- function(dat) {
  h_report <- new_handle()
  handle_setopt(h_report, customrequest = "POST")
  handle_setform(h_report, .list = list(data = as.character(dat)))
  handle_setheaders(h_report, "AccessToken" = auth_key)
  return(h_report)
}

pool <- new_pool(total_con = 100, host_con = 100)
cb <- function(req) {
  cat(rawToChar(req$content), ",")
}

print(rawToChar(curl_fetch_memory(test, handle = build_h_start())$content))
dat <- c()

rate <- rate_delay(1)
req_1 <-
  slowly(
    ~ curl_fetch_memory(test, handle = build_h())$content %>%
      rawToChar() %>% jsonlite::fromJSON(),
    rate = rate,
    quiet = F
  )

map(1:100, ~ req_1()) -> res

dat <- unlist(res)

dat %>% 
  map(~ curl_fetch_multi(
    test,
    pool = pool,
    done = cb,
    handle = build_h_report(.x)
  )) -> 
  report

build_h_end <- function() {
  h_start <- new_handle()
  handle_setopt(h_start, customrequest = "PUT")
  handle_setform(h_start, .list = list(flag = "END"))
  handle_setheaders(h_start, "AccessToken" = auth_key)
  return(h_start)
}
out <- multi_run(pool = pool)
tem <- rawToChar(curl_fetch_memory(test, handle = build_h_end())$content)
Encoding(tem)<-"UTF-8"
tem