madeliri/shiny_form
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactoring app

Browse Source
This commit is contained in:
madeliri
2025-06-22 16:20:15 +03:00
parent 8dfd85736b
commit 9fd1874c72
6 changed files with 566 additions and 302 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
helpers/db.R
View File

@@ -1,57 +0,0 @@
# based on https://github.com/datastorm-open/shinymanager/
#' @export
write_db_encrypt <- function(conn, value, name, passphrase = Sys.getenv("AUTH_DB_KEY")) {
if (is.character(conn)) {
conn <- DBI::dbConnect(RSQLite::SQLite(), dbname = conn)
on.exit(DBI::dbDisconnect(conn))
}
if (name == "credentials" && "password" %in% colnames(value)) {
if (!"is_hashed_password" %in% colnames(value)) {
value$is_hashed_password <- FALSE
}
to_hash <- which(!as.logical(value$is_hashed_password))
if (length(to_hash) > 0) {
# store hashed password
value$password[to_hash] <- sapply(value$password[to_hash], function(x) scrypt::hashPassword(x))
value$is_hashed_password[to_hash] <- TRUE
}
}
if (!is.null(passphrase)) {
passphrase <- as.character(passphrase)
passphrase <- charToRaw(passphrase)
key <- openssl::sha256(passphrase)
value_serialized <- serialize(value, NULL)
value_encrypted <- openssl::aes_cbc_encrypt(data = value_serialized, key = key)
value <- data.frame(value = I(list(value_encrypted)), iv = I(list(attr(value_encrypted, "iv"))))
}
DBI::dbWriteTable(conn = conn, name = name, value = value, overwrite = TRUE)
}
#' @export
read_db_encrypt <- function(conn, name, passphrase = Sys.getenv("AUTH_DB_KEY")) {
if (is.character(conn)) {
conn <- DBI::dbConnect(RSQLite::SQLite(), dbname = conn)
on.exit(DBI::dbDisconnect(conn))
}
out <- DBI::dbReadTable(conn = conn, name = name)
if (!is.null(passphrase)) {
passphrase <- as.character(passphrase)
passphrase <- charToRaw(passphrase)
key <- openssl::sha256(passphrase)
value <- out$value[[1]]
attr(value, "iv") <- out$iv[[1]]
out <- openssl::aes_cbc_decrypt(value, key = key)
out <- unserialize(out)
}
return(out)
}

71
helpers/functions.R
View File

@@ -6,12 +6,12 @@ get_dummy_data <- function(type) {
if (type %in% c("number")) return(as.double(999))
}
get_empty_data <- function(type) {
if (type %in% c("text", "select_one", "select_multiple")) return(as.character(NA))
if (type %in% c("radio", "checkbox")) return(as.character(NA))
if (type %in% c("date")) return(as.Date(NA))
if (type %in% c("number")) return(as.character(NA))
}
# get_empty_data <- function(type) {
# if (type %in% c("text", "select_one", "select_multiple")) return(as.character(NA))
# if (type %in% c("radio", "checkbox")) return(as.character(NA))
# if (type %in% c("date")) return(as.Date(NA))
# if (type %in% c("number")) return(as.character(NA))
# }
get_dummy_df <- function() {
purrr::map(
@@ -45,62 +45,3 @@ check_for_empty_data <- function(value_to_check) {
FALSE
}
#' @description Function update input forms.
#' @param id - input form id;
#' @param type - type of form;
#' @param value - value to update;
update_forms_with_data <- function(id, type, value) {
if (type == "text") {
shiny::updateTextAreaInput(inputId = id, value = value)
}
if (type == "number") {
shiny::updateTextAreaInput(inputId = id, value = value)
}
# supress warnings when applying NA or NULL to date input form
if (type == "date") {
suppressWarnings(
shiny::updateDateInput(inputId = id, value = value)
)
}
# select_one
if (type == "select_one") {
shiny::updateSelectizeInput(inputId = id, selected = value)
}
# select_multiple
# check if value is not NA and split by delimetr
if (type == "select_multiple" && !is.na(value)) {
vars <- stringr::str_split_1(value, "; ")
shiny::updateSelectizeInput(inputId = id, selected = vars)
}
# in other case fill with `character(0)` to proper reseting form
if (type == "select_multiple" && is.na(value)) {
shiny::updateSelectizeInput(inputId = id, selected = character(0))
}
# radio buttons
if (type == "radio" && !is.na(value)) {
shiny::updateRadioButtons(inputId = id, selected = value)
}
if (type == "radio" && is.na(value)) {
shiny::updateRadioButtons(inputId = id, selected = character(0))
}
# checkboxes
if (type == "checkbox" && !is.na(value)) {
vars <- stringr::str_split_1(value, "; ")
shiny::updateCheckboxGroupInput(inputId = id, selected = vars)
}
if (type == "checkbox" && is.na(value)) {
shiny::updateCheckboxGroupInput(inputId = id, selected = character(0))
}
if (type == "inline_table") {
message("EMPTY")
}
}