R/encryptDataDS.R

In patRyserWelch8/dsShareServer: Provide the server-side functions for privacy-preserving sharing of parameters and encrypted datasets

edds.conceal.data <- function(concealing.matrix, data, columns)
{

  if(is.matrix(concealing.matrix) & is.list(data) & is.vector(columns))
  {

    no.params <- length(data)

    if (length(data) == length(columns))
    {

      outcome   <- concealing.matrix

      for (index in 1:no.params)
      {
          column <- columns[index]
          if(length(data[[index]]) == nrow(concealing.matrix) &
             column < ncol(concealing.matrix))
          {
             concealing.matrix[,column]  <- data[[index]]
          }
      }
    }
  }
  return(concealing.matrix)
}


edds.define_no_rows <- function(settings)
{
  no.rows <- 2
  continue <- TRUE
  repeat
  {
    seed <- generate.secure.seed(settings)

    if(seed < .Machine$integer.max)
    {
      break()
    }
  }
  set.seed(seed)
  while(continue)
  {
    no.rows <- as.integer(stats::runif(1, min = settings$min_rows, max = settings$max_rows))
    if(no.rows %% 2 == 1  &
       no.rows >= settings$min_columns & no.rows <= settings$max_columns)
    {
      continue = FALSE
    }
  }
  return(no.rows)
}

edds.define_no_columns <- function(settings, no.rows = 2)
{
  if (is.numeric(no.rows))
  {
      no.columns <- no.rows
      continue = TRUE

      repeat
      {
        seed <- generate.secure.seed(settings)
        if(seed < .Machine$integer.max)
        {
          break()
        }
      }
      set.seed(seed)
      while(continue)
      {
        no.columns <- as.integer(stats::runif(1, min = settings$min_columns, max = settings$max_columns))
        if(no.columns %% 2 == 1 &  no.columns != no.rows  &
           no.columns >= settings$min_columns & no.columns<= settings$max_columns)
        {
           continue = FALSE
        }

      }
      return(no.columns)
  }
  else
  {
    stop("incorrect argument")
  }
}

edds.create.matrix.runif <- function(settings, no.rows = 0 , no.columns = 0, min.value= 0, max.value = 1)
{
  result <- matrix(c(0),settings$min_rows,settings$min_columns)

  if (is.numeric(no.rows) && is.numeric(no.columns)
      && length(no.rows)  ==  1 && length(no.columns) == 1)
  {
    if (no.rows < settings$min_rows)
    {
      no.rows    <- settings$min_rows
    }

    if (no.columns < settings$min_columns)
    {
      no.columns <- settings$min_columns
    }

    repeat
    {
      seed <- generate.secure.seed(settings)
      if(seed < .Machine$integer.max)
      {
        break()
      }
    }

    set.seed(seed)
    random.numbers <- stats::runif(no.rows * no.columns, min = min.value, max = max.value)
    result         <-  matrix(random.numbers,no.rows,no.columns)

  }

  return(result)
}


edds.encrypt.concealed.data <- function(settings, sharing, master_mode = TRUE)
{
  outcome        <- sharing
  values.exists  <- all(c(settings$concealing,settings$masking) %in% names(sharing))

  if(values.exists)
  {
    #initialise some variables
    no.row         <- nrow(sharing[[settings$concealing]])
    no.col         <- ncol(sharing[[settings$masking]])
    matrix.product <- matrix(rep(0,no.row * no.col),no.row, no.col)

    if(is.matrix(sharing[[settings$concealing]]) & is.matrix(sharing[[settings$masking]]))
    {

      #apply rules master and receiver rules.
      if (master_mode)
      {
        #encode the concealing matrix with the transpose of  masking matrix and concealing matrix
        masking     <- t(sharing[[settings$masking]])
        concealing  <- t(sharing[[settings$concealing]])
      }
      else
      {
        #encode the concealing matrix without transporing masking matrix and concealing matrix
        masking     <- sharing[[settings$masking]]
        concealing  <- sharing[[settings$concealing]]
      }

      #complete multiplication


      if (ncol(masking) == nrow(concealing))
      {
        matrix.product <- masking %*% concealing
      }
    }

    outcome[[settings$encrypted]] <- matrix.product

  }

  return(outcome)
}

#This helper function create a concealing.matrix and a master matrix. No data has yet to created.
#The number of rows and columns is defined randomly. The index_y is set. When encrypted the matrix is transposed and
#the chosen column becomes a row.
edds.create.structure.master <- function(settings, min, max,no.rows, no.columns)
{
    outcome                         <- list()
    outcome[[settings$concealing]]  <- edds.create.matrix.runif(settings, no.rows, no.columns, min, max)
    outcome[[settings$masking]]     <- edds.create.matrix.runif(settings, no.columns, no.columns, min, max)
    outcome[[settings$no_columns]]  <- no.columns
    outcome[[settings$no_rows]]     <- no.rows

    return(outcome)
}

#This helper function creates the concealing matrix. The matrix dimension uses again the dimension of the received matrix.
#The number of rows for the concealing matrix is the number of columns from the received.matrix. The number of columns
#for the concealing matrix is the number of rows from the received.matrix.  The masking matrix becomes the received matrix.
edds.create.structure.receiver <- function(settings, sharing, min, max, envir)
{
  outcome <- list()
  #if(exists(get.sharing.name(),envir = envir))
  #{
    #received.data    <- get(get.sharing.name(), envir - envir)
    # get sharing data - states of the search
    received.data    <- sharing
    # check received data exist
    value.exists     <- settings$received %in% names(received.data)
    if (value.exists)
    {
      #transpose is required counter the transpose in master
      no.rows.received                <- nrow(t(received.data[[settings$received]]))
      no.columns.received             <- ncol(t(received.data[[settings$received]]))

      outcome[[settings$concealing]]  <- edds.create.matrix.runif(settings, no.rows.received, no.columns.received, min, max)

      outcome[[settings$masking]]     <- received.data[[settings$received]]
      outcome[[settings$no_columns]]  <- no.columns.received
      outcome[[settings$no_rows]]     <- no.rows.received
    }
  #}
  return(outcome)
}


edds.is.encrypted.valid <- function(sharing, expected.fields)
{
  correct <- FALSE

  if (is.list(sharing) & is.vector(expected.fields))
  {
    list.attributes  <- names(sharing)
    attributes.exist <- list.attributes %in% expected.fields
    total.correct    <-  sum(attributes.exist == TRUE)
    correct          <- (total.correct == length(expected.fields))
   }

  return(correct)
}

edds.preserve.info <- function(settings, sharing)
{

  outcome      <- list()
  field_names  <- names(sharing)
  correct_info <- all(c(settings$index_x,settings$index_y)
                      %in% field_names)
  data_exists <- all(settings$data %in% field_names)

  if(correct_info)
  {
       if (all(sharing[[settings$index_x]] < 1) &
           all(sharing[[settings$index_y]] < 1))
       {
          outcome[[settings$index_x]] <- sharing[[settings$index_x]]
          outcome[[settings$index_y]] <- sharing[[settings$index_y]]
          outcome[["columns"]]        <- ceiling(sharing[[settings$index_x]] * sharing[[settings$no_columns]])
          outcome[["rows"]]           <- ceiling(sharing[[settings$index_y]] * sharing[[settings$no_rows]])

          if(data_exists)
          {
              #extract the data save earlier in the process
              outcome[[settings$data]] <- sharing[[settings$data]]
          }
          else
          {

              #extract each column to be preserved from the concealing matrix
              outcome[[settings$data]] <- list()

              for(index in 1:length(outcome[["columns"]]))
              {
                column <- outcome[["columns"]][index]
                outcome[[settings$data]][[index]] <- sharing[[settings$concealing]][,column]
              }
          }
       }
  }


  return(outcome)
}

edds.encrypt.data <- function(settings, master_mode, preserve_mode, envir)
{
  #init variables
  MIN            <- stats::runif(1, min=settings$min_value, max  = settings$min_value + 20)
  MAX            <- stats::runif(1, min=settings$min_value+30, max = settings$min_value + 40)
  data           <- NULL

  expected.list   <- c()
  no.rows         <- edds.define_no_rows(settings = settings)
  no.columns      <- edds.define_no_columns(settings = settings, no.rows = no.rows)
  sharing         <- get.sharing(envir = envir)
  saved.info      <- list()

  #preserve the data from previous exchange, if it is required.
  if(preserve_mode) #steps 6 and 8
  {
    saved.info    <-  edds.preserve.info(settings, sharing)
    no.rows       <-  sharing[[settings$no_rows]]
    no.columns    <-  sharing[[settings$no_columns]]
  }
  print(preserve_mode)
  print(paste("no rows",no.rows))
  print(paste("no columns" ,no.columns))

  #create matrices for encryption.

  if (master_mode)
  {
    #master_mode is in steps 1 and 6 of the exchange
    sharing       <- edds.create.structure.master(settings, MIN, MAX,
                                        no.rows = no.rows,
                                        no.columns = no.columns)
    expected.list <- c(settings$concealing,settings$masking,
                       settings$encrypted,settings$no_columns, settings$no_rows)
  }
  else
  {
    # not master mode: steps 3 and 8
    sharing       <- edds.create.structure.receiver(settings, sharing, MIN, MAX, envir)
    expected.list <- c(settings$concealing,settings$masking,settings$encrypted,settings$no_columns, settings$no_rows)
  }

  if (preserve_mode) #steps 6 and 8
  {
    if(master_mode) #step 6
    {

      sharing[[settings$concealing]] <- edds.conceal.data(sharing[[settings$concealing]],
                                                      saved.info[[settings$data]],saved.info[["rows"]])
    }
    else #step 8
    {
      sharing[[settings$concealing]] <- edds.conceal.data(sharing[[settings$concealing]],
                                                      saved.info[[settings$data]],saved.info[["columns"]])
    }
    sharing[[settings$index_x]]    <-  saved.info[[settings$index_x]]
    sharing[[settings$index_y]]    <-  saved.info[[settings$index_y]]

    expected.list <- c(settings$concealing,settings$masking,settings$encrypted,
                       settings$no_columns, settings$no_rows, settings$index_x, settings$index_y)
  }


  sharing     <- edds.encrypt.concealed.data(settings, sharing, master_mode)
  assign(get.sharing.name(), sharing, envir = envir)
  return(expected.list)

}

#'@name encryptDataDS
#'@title  encrypt some data on the server for sharing some parameters
#'@description This server function uses some matrices operations to encrypts some data required to exchange a parameter securely between two DataSHIELD server.
#'@details This function encrypts data in four different ways; each of them are defined by the combination of argument values.
#'\itemize{
#'\item{\code{master_mode = TRUE, preserve_mode = FALSE}} {- This combination of argument values indicates the server is in \strong{master_mode}. An exchange of encrypted data is  initiated. It is the first step of the exchange.}
#'\item{\code{master_mode = FALSE, preserve_mode = FALSE}} {- This set of argument values states the server is in \strong{receiver_mode}. Some data received from the master is
#'used again to encrypted a \strong{receiver_server specific} data. }
#'\item{\code{master_mode = TRUE, preserve_mode = TRUE}} {- When both argument values are set to true, some data used previously in the process are
#'concealed in within some newly generated data.}
#'\item{\code{master_mode = FALSE, preserve_mode = TRUE}} {- This set of argument values states the server is in \strong{receiver_mode}. Some data received from the master is
#'used again to encrypted a \strong{receiver_server specific} data. Some data previously used by the process are preserved.}
#'}
#'@param master_mode Boolean argument. It indicates the mode of encryption. By default, set to TRUE.
#'@param preserve_mode  Boolean argument. It indicates to presever some data exchanged previously between servers. By default, set to FALSE.
#'@importFrom stats runif
#'@export
encryptDataDS <- function(master_mode = TRUE, preserve_mode = FALSE)
{
  if (is.logical(master_mode) & is.logical(preserve_mode))
  {

     if(is.sharing.allowed())
     {
       env           <- globalenv()
       settings      <- get.settings(envir = env)
       expected.list <- edds.encrypt.data(settings, master_mode, preserve_mode, env)
       outcome       <- edds.is.encrypted.valid(get.sharing(), expected.list) &
                        exists(get.sharing.name(), where = env)
       return(outcome)
     }
     else
     {
       stop("SERVER::ERR::SHARING::001")
     }
  }
  else
  {
    stop("SERVER::ERR::SHARING::002")
  }
}