Reworked Kraken API

The Kraken API supports open-interest. This commit prepares the Kraken endpoint and cleans up the code. Kraken open-interest testing has been prepared and is ready for action when the endpoint is up and running

R/api_kraken.R

@@ -167,6 +167,14 @@ krakenResponse <- function(
         index_location = c(1),
         colum_location = c(4,5)
       )
+    },
+
+    interest = {
+      list(
+        colum_names     = c('first', 'second', 'third', "fourth"),
+        index_location = c(1),
+        colum_location = c(2,3,4,5)
+      )
     }
   )
 
@@ -188,16 +196,21 @@ krakenDates <- function(
       x = as.numeric(dates),
       multiplier = ifelse(
         futures,
-        yes = if (type %in% c('lsratio','interest')) 1 else 1000, # was 1000
+        yes = if (type %in% c('lsratio', "interest")) 1 else 1000, # was 1000
         no = 1
       )
     )
 
   } else {
 
+
     dates <- convert_date(
       x = dates,
-      multiplier = 1
+      multiplier = ifelse(
+        type == "interest",
+        yes = 1,
+        no  = 1
+      )
       )
 
     if (!futures) {
@@ -248,100 +261,65 @@ krakenParameters <- function(
     is_response = FALSE
   )
 
-  if (type == "interest") {
-
-
-    # Set specific parameters for futures or non-futures
-    if (futures) {
-      params$symbol <-  params$ticker
-      params$resolution <-  params$interval
-      params$tick_type <-  'long-short-ratiotrade'
-      params$from <- date_params[1]
-      params$to <-  date_params[2]
-      params$query <-  list(
-        interval = params$interval,
-        since = date_params[1],
-        to    =  date_params[2]
-      )
-      params$path <-  list(
-        symbol = params$symbol,
-        tick_type = "open-interest"
-      )
-    } else {
-
-      params$pair <-  params$ticker
-      params$query <-  list(
-        since = date_params[1],
-        pair = params$pair,
-        interval = params$interval
-      )
-      params$path <-  NULL
-    }
-  }
-
-  if (type == 'ohlc') {
-
-    # Set specific parameters for futures or non-futures
-    if (futures) {
+  switch(
+    type,
+    interest = {
       params$symbol <- params$ticker
-      params$resolution <-  params$interval
-      params$tick_type <-  'trade'
-      params$from <-  date_params[1]
-      params$to <-  date_params[2]
-      params$query <-  list(
+      params$resolution <- params$interval
+      params$query <- list(
         interval = params$interval,
-        from = date_params[1],
-        to =date_params[2]
+        since    = date_params[1],
+        to       =  date_params[2]
       )
       params$path <- list(
-        tick_type = 'trade',
-        symbol = params$symbol,
-        resolution = params$resolution
-      )
-    } else {
-
-      params$pair <-  params$ticker
-      params$query <-  list(
-        since = date_params[1],
-        to    = date_params[2],
-        pair = params$pair,
-        interval = params$interval
+        symbol    = params$symbol,
+        tick_type = "open-interest"
       )
-      params$path <-  NULL
-    }
+    },
+    ohlc = {
+      # Set specific parameters for futures or non-futures
+      if (futures) {
+        params$symbol <- params$ticker
+        params$resolution <- params$interval
+        params$query <-  list(
+          interval = params$interval,
+          from     = date_params[1],
+          to       = date_params[2]
+        )
+        params$path <- list(
+          tick_type  = 'trade',
+          symbol     = params$symbol,
+          resolution = params$resolution
+        )
+      } else {
 
-  }
+        params$pair <- params$ticker
+        params$query <- list(
+          since    = date_params[1],
+          to       = date_params[2],
+          pair     = params$pair,
+          interval = params$interval
+        )
+        params$path <-  NULL
+      }
 
-  if (type == "lsratio") {
 
-    # Set specific parameters for futures or non-futures
-    if (futures) {
-      params$symbol <-  params$ticker
+
+    },
+    lsratio = {
+      params$symbol <- params$ticker
       params$resolution <- params$interval
-      params$tick_type <-  'long-short-ratiotrade'
-      params$from <-  date_params[1]
-      params$to <-  date_params[2]
-      params$query <-  list(
+      params$query <- list(
         interval = params$interval,
-        since = date_params[1],
-        to    =  date_params[2]
+        since    = date_params[1],
+        to       =  date_params[2]
       )
       params$path <-  list(
         symbol = params$symbol,
         tick_type = 'long-short-info'
       )
-    } else {
-
-      params$pair <-  params$ticker
-      params$query <-  list(
-        since = date_params[1],
-        pair = params$pair,
-        interval = params$interval
-      )
-      params$path <-  NULL
     }
-
-  }
+  )
 
   # Common parameters for both futures and non-futures
   params$futures <-  futures
@@ -351,4 +329,4 @@ krakenParameters <- function(
   params
 }
 
-#  # script end;
+# script end;

R/available_exchanges.R

@@ -73,7 +73,7 @@ available_exchanges <- function(
       ohlc        = c('binance', 'kucoin', 'kraken', 'bitmart', 'bybit'),
       fundingrate = c('binance', 'bybit', 'kucoin'),
       lsratio     = c('binance', 'bybit', 'kraken'),
-      interest    = c('binance', 'bybit')
+      interest    = c('binance', 'bybit') # Working on Kraken at the moment.
     )
   )
 

R/utils.R

@@ -280,7 +280,6 @@ fetch <- function(
         type   = type,
         futures = futures,
         ...
-
       ),
       query = parameters$query,
       path  = parameters$path
@@ -304,25 +303,29 @@ fetch <- function(
     what = c('array', 'matrix', 'data.frame')
   )
 
-
   # 2.2) extract data
   # from reponse:
   #
   # NOTE: if this fails
   # then it is likely
   # that we are dealing with
   # an error, or Kraken
+  #
+  # This could be done using do.call
+  # maybe
   response <- tryCatch(
     expr = {
       response[[which(idx)]]
     },
     error = function(error){
-      as.data.frame(response)
+      do.call(
+        data.frame,
+        response
+      )
+      #as.data.frame(response)
     }
   )
 
-
-
   # 3) Extract source specific
   # response parameters
   parameters <- get(

playground/playground.R

@@ -9,4 +9,141 @@
 # setup;
 rm(list = ls()); gc(); devtools::load_all()
 
+get_openinterest(
+  "PF_SUIUSD",
+  source = "kraken",
+  interval = "1h"
+)
+
+
+test <- source_parameters(
+  source = "kraken",
+  futures = TRUE,
+  type = "interest",
+  ticker = "PF_SUIUSD",
+  interval = "1h",
+  from = as.POSIXct(Sys.Date() - 1),
+  to   = Sys.time()
+)
+
+
+response <- GET(
+  url = baseUrl(
+    source = "kraken",
+    futures = TRUE
+  ),
+  endpoint = endPoint(
+    "kraken",
+    type = "interest",
+    futures = TRUE
+  ),
+  query = test$query,
+  path  = test$path
+)
+
+response <- flatten(
+  response
+)
+
+idx <- vapply(
+  X = response,
+  FUN.VALUE = logical(1),
+  FUN = inherits,
+  what = c('array', 'matrix', 'data.frame')
+)
+
+response <- tryCatch(
+  expr = {
+    response[[which(idx)]]
+  },
+  error = function(error){
+    do.call(
+      data.frame,
+      response
+    )
+    #as.data.frame(response)
+  }
+)
+
+
+# 3) Extract source specific
+# response parameters
+parameters <- get(
+  paste0(
+    "kraken", 'Response'
+  )
+)(
+  type = "interest",
+  futures = TRUE
+)
+
+# 3.1) wrap parameters
+# in tryCatch to check wether
+# the columns exists
+column_list <- tryCatch(
+  expr = {
+    list(
+      index = response[, parameters$index_location],
+      core  = rbind(response[,parameters$colum_location])
+    )
+  },
+  error = function(error) {
+
+    assert(
+      FALSE,
+      error_message = error_message
+    )
+
+  }
+)
+
+# 3.1.1) extract the values
+# from the list
+index <- column_list$index
+core  <- column_list$core
+
+# 3.1.2) convert
+# all to as.numeric
+core <- apply(
+  X = core,
+  MARGIN = 2,
+  FUN = as.numeric
+)
+
+# 3.1.3) convert dates
+# to positxct
+index <- get(
+  paste0(
+    "kraken", 'Dates'
+  )
+)(
+  futures = TRUE,
+  dates   = index,
+  is_response = TRUE,
+  type    = "interest"
+)
+
+
+
+
+# 4) convert to xts
+# from data.frame
+# NOTE: This throws an error
+# for KRAKEN no idea why
+response <- xts::as.xts(
+  zoo::as.zoo(
+    core
+  ),
+  index
+)
+# 4.1) set column
+# names
+colnames(response) <- parameters$colum_names
+
+
+response
+
+# NOTE: The error in the Kraken exchange is in the
+# way that unix are passed.
+
 # script end;