diff --git a/README.md b/README.md index 8e663c6..77283eb 100644 --- a/README.md +++ b/README.md @@ -16,17 +16,17 @@ The Safer Streets Priority Finder (SSPF) enables you to analyze the risk to bicy You don't need to follow these instructions to use the tool, which is available for public use at the link included above. You only need to follow these instructions if you'd like to build your own version of the SSPF software. 1. **Linux** - You'll need sudo access on a Linux command line. -2. **A PostgreSQL Relational Database** - Access to a PostgreSQL database that follows the schema and table structure provided [here](https://github.com/tooledesign/Safer-Streets-Priority-Finder/blob/main/build_psql_db.sql). +2. **A PostgreSQL Relational Database** - Access to a PostgreSQL database that follows the schema and table structure provided [here](https://github.com/tooledesign/Safer-Streets-Priority-Finder/blob/main/general/build_psql_db.sql). 3. **Static tables** - Upload the following table into the 'static' schema on the PostgreSQL datatable. 1. [Fatality Analysis Reporting System (FARS) 2015 - 2019](https://www.nhtsa.gov/file-downloads?p=nhtsa/downloads/FARS/) - as, static.national_fclass_priors - 2. [USDOT-OST / Pedestrian-Fatality-Risk-Project](https://github.com/USDOT-OST/Pedestrian-Fatality-Risk-Project) - as, static.fars_processed + 2. [USDOT-OST / Pedestrian-Fatality-Risk-Project](https://github.com/USDOT-OST/Pedestrian-Fatality-Risk-Project) - as, static.national_tracts 3. [US Census Counties](https://www.census.gov/data.html) - as, static.us_county_2018 4. [National Open Street Map Roads Dataset, Available from GeoFabrik](https://www.geofabrik.de/data/download.html) - as, static.osm_centerlines - 5. [Functional Classification Priors](https://github.com/tooledesign/Safer-Streets-Priority-Finder/blob/main/national_fclass_priors.csv) - as, static.osm_centerlines + 5. [Functional Classification Priors](https://github.com/tooledesign/Safer-Streets-Priority-Finder/blob/main/general/national_fclass_priors.csv) - as, static.national_fclass_priors Datasets 1-4 need a state and county [Federal Information Processing Standards (FIPS)](https://www.nist.gov/standardsgov/compliance-faqs-federal-information-processing-standards-fips#:~:text=FIPS%20are%20standards%20and%20guidelines,by%20the%20Secretary%20of%20Commerce) code, where the state FIPS code is always two digits in length, and county codes are three digits, including leading zeros as needed. FIPS codes on each dataset should be stored in TEXT or VARCHAR format. - See [this file](https://github.com/tooledesign/Safer-Streets-Priority-Finder/blob/main/build_psql_db.sql) for more infomration on the data structure for each table listed above. + See [this file](https://github.com/tooledesign/Safer-Streets-Priority-Finder/blob/main/general/build_psql_db.sql) for more infomration on the data structure for each table listed above. 4. **Complete system variables** - Fill out your system variables, so the Docker container can link the user information with the data. You'll need to do this [here](https://github.com/tooledesign/Safer-Streets-Priority-Finder/blob/main/safer_streets_priority_finder/env_variables.R) and [here](https://github.com/tooledesign/Safer-Streets-Priority-Finder/blob/main/vulusr_model_processor/env_variables.R). Do not relocate this file. 5. **Docker** - If you don't already have Docker installed on your machine, you can get started [here](https://docs.docker.com/get-docker/). @@ -64,6 +64,8 @@ Update all variables in that file. Here's a breakdown of what each variable refe 8. **AWS_SECRET_ACCESS_KEY** - AWS S3 secret access key 9. **AWS_DEFAULT_REGION** - AWS S3 location 10. **S3_BUCKET** - Name of the S3 bucket +11. **PEPPER** - random string of character, used in encyption +12. **USER_DATA_KEY** - key to decipher encrypted messages Now do the same for the report processor. diff --git a/build_psql_db.sql b/general/build_psql_db.sql similarity index 97% rename from build_psql_db.sql rename to general/build_psql_db.sql index 4da0942..03cb090 100644 --- a/build_psql_db.sql +++ b/general/build_psql_db.sql @@ -6,6 +6,9 @@ CREATE DATABASE sspf; -- add postgis CREATE EXTENSION postgis; +-- add pgcrypto +CREATE EXTENSION pgcrypto; + -- create schema in sspf database CREATE SCHEMA gen_management; CREATE SCHEMA local_user_data; @@ -186,3 +189,10 @@ CREATE INDEX us_county_2018_geom_geom_idx ON static.us_county_2018 USING gist (geom) TABLESPACE pg_default; + +CREATE TABLE gen_management.salt +( + username TEXT, + salt TEXT, + time_created TIMESTAMP DEFAULT NOW() +) diff --git a/national_fclass_priors.csv b/general/national_fclass_priors.csv similarity index 100% rename from national_fclass_priors.csv rename to general/national_fclass_priors.csv diff --git a/safer_streets_priority_finder/Dockerfile b/safer_streets_priority_finder/Dockerfile index 1092e15..e74b708 100644 --- a/safer_streets_priority_finder/Dockerfile +++ b/safer_streets_priority_finder/Dockerfile @@ -21,6 +21,7 @@ RUN apt-get update && apt-get install -y --no-install-recommends\ libnode-dev \ bzip2 \ libfontconfig \ + libsodium-dev \ && apt-get clean \ && rm -rf /var/lib/apt/lists/* @@ -52,6 +53,7 @@ RUN Rscript -e 'remotes::install_version("shiny",upgrade="never", version = "1.6 RUN Rscript -e 'remotes::install_version("config",upgrade="never", version = "0.3")' RUN Rscript -e 'remotes::install_github("Thinkr-open/golem@aaae5c8788802a7b4aef4df23691902a286dd964")' +RUN Rscript -e 'remotes::install_version("sodium",upgrade="never", version = "1.1")' RUN Rscript -e 'remotes::install_version("shinydashboardPlus",upgrade="never", version = "2.0.0")' RUN Rscript -e 'remotes::install_version("shinydashboard",upgrade="never", version = "0.7.1")' RUN Rscript -e 'remotes::install_version("tidyverse",upgrade="never", version = "1.3.0")' @@ -81,11 +83,11 @@ RUN Rscript -e 'remotes::install_version("shinycssloaders",upgrade="never", vers RUN Rscript -e 'remotes::install_version("webshot",upgrade="never", version = "0.5.2")' RUN Rscript -e 'remotes::install_version("tinytex",upgrade="never", version = "0.32")' RUN Rscript -e 'tinytex::install_tinytex()' -RUN Rscript -e 'remotes::install_version("shinydisconnect",upgrade="never", version = "0.1.0")' RUN Rscript -e 'remotes::install_version("leafgl",upgrade="never", version = "0.1.1")' RUN Rscript -e 'remotes::install_version("emayili",upgrade="never", version = "0.4.15")' RUN Rscript -e 'remotes::install_version("shinybusy",upgrade="never", version = "0.2.2")' RUN Rscript -e 'remotes::install_version("aws.s3",upgrade="never", version = "0.3.21")' +RUN Rscript -e 'remotes::install_version("shinydisconnect",upgrade="never", version = "0.1.0")' COPY env_variables.R /srv/shiny-server/App/env_variables.R diff --git a/safer_streets_priority_finder/R/app_server.R b/safer_streets_priority_finder/R/app_server.R index 56db88d..bae7735 100644 --- a/safer_streets_priority_finder/R/app_server.R +++ b/safer_streets_priority_finder/R/app_server.R @@ -129,11 +129,10 @@ app_server <- function( input, output, session ) { } else if (user_added == 'User added') { # checks 1-4 have passed, create username login - user_id <- get_user_id(connection=connection, username=tolower(input$chosen_username), password=tolower(input$chosen_password)) - run_id <- get_run_id(connection=connection, username=tolower(input$chosen_username), run_id=tolower(input$chosen_run_id)) + data$user_id <- get_user_id(connection=connection, username=tolower(input$chosen_username), password=tolower(input$chosen_password)) + data$run_id <- get_run_id(connection=connection, username=tolower(input$chosen_username), run_id=tolower(input$chosen_run_id)) removeModal() - data$user_id <- user_id - data$run_id <- run_id + waiter::waiter_show( color='rgba(175, 175, 175, 0.85)', html = tagList( @@ -144,14 +143,14 @@ app_server <- function( input, output, session ) { ) # call the servers for each module - callModule(mod_load_data_server, "load_data_ui_1", connection=connection, user_id=user_id, run_id=run_id) - callModule(mod_reporter_server, "reporter_ui_1", connection=connection, user_id=user_id, run_id=run_id) - callModule(mod_build_sliding_windows_server, "build_sliding_windows_ui_1", connection=connection, user_id=user_id, run_id=run_id) - callModule(mod_build_model_server, "build_model_ui_1", connection=connection, user_id=user_id, run_id=run_id) - callModule(mod_visualize_data_reporter_server, "visualize_data_reporter_ui_1", connection=connection, user_id=user_id, run_id=run_id) + callModule(mod_load_data_server, "load_data_ui_1", connection=connection, user_id=data$user_id, run_id=data$run_id) + callModule(mod_reporter_server, "reporter_ui_1", connection=connection, user_id=data$user_id, run_id=data$run_id) + callModule(mod_build_sliding_windows_server, "build_sliding_windows_ui_1", connection=connection, user_id=data$user_id, run_id=data$run_id) + callModule(mod_build_model_server, "build_model_ui_1", connection=connection, user_id=data$user_id, run_id=data$run_id) + callModule(mod_visualize_data_reporter_server, "visualize_data_reporter_ui_1", connection=connection, user_id=data$user_id, run_id=data$run_id) # update time the user last logged in - DBI::dbGetQuery(connection, glue::glue(" UPDATE gen_management.accounts SET last_login = NOW() WHERE user_id = {user_id} AND run_id = \'{run_id}\'; ")) + DBI::dbGetQuery(connection, glue::glue(" UPDATE gen_management.accounts SET last_login = NOW() WHERE user_id = {data$user_id} AND run_id = \'{data$run_id}\'; ")) login_configs <- callModule(mod_login_config_server, "login_config_ui_1", @@ -185,7 +184,7 @@ app_server <- function( input, output, session ) { user_id <- get_user_id(connection=connection, username=tolower(input$username), password=tolower(input$password)) if ( user_id == -999 ) { shiny_warming_alert(title = 'Incorrect Login', text='It looks like that username and password combination doesn\'t exist.') - } else if (length(user_id) == 0) { + } else if (length(user_id) == 0 || (is.integer(user_id) && length(user_id) == 0L) ) { shiny_warming_alert(title = 'Something went wrong', text='It looks like you\'re session disconnected from the database. Please reload the page.') } else { # check for run ID diff --git a/safer_streets_priority_finder/R/app_ui.R b/safer_streets_priority_finder/R/app_ui.R index 0b8172a..d3e2010 100644 --- a/safer_streets_priority_finder/R/app_ui.R +++ b/safer_streets_priority_finder/R/app_ui.R @@ -27,7 +27,7 @@ page <- function(user_id, run_id) { navbar = bs4Dash::bs4DashNavbar( skin = "dark", status = "primary", - leftUi = h5("Safer Streets Priority Finder, Beta V 1.0", style="color:#f8f9fa; align-self: flex-end;"), + leftUi = h5("Safer Streets Priority Finder, Beta V 1.1", style="color:#f8f9fa; align-self: flex-end;"), rightUi = uiOutput('logout_header_area') diff --git a/safer_streets_priority_finder/R/fct_login_funcs.R b/safer_streets_priority_finder/R/fct_login_funcs.R index 6bdfa76..b4993e5 100644 --- a/safer_streets_priority_finder/R/fct_login_funcs.R +++ b/safer_streets_priority_finder/R/fct_login_funcs.R @@ -4,9 +4,11 @@ test_for_run <- function(connection, username, run_id){ tryCatch({ username <- DBI::dbQuoteString(connection,username) run_id <- DBI::dbQuoteString(connection,run_id) - q <- glue::glue('SELECT (EXISTS (SELECT FROM gen_management.accounts WHERE username = {username} AND run_id = {run_id} ))::INTEGER;') + + q <- glue::glue("SELECT (EXISTS (SELECT FROM gen_management.accounts WHERE username = {username} AND run_id = {run_id} ))::INTEGER;") + exists <- DBI::dbGetQuery(connection, q)[1,1] - if (exists == 0 ) { + if (exists == 0 ) { return('FALSE') } else if (exists == 1) { return('TRUE') @@ -24,18 +26,23 @@ test_for_run <- function(connection, username, run_id){ get_user_id <- function(connection, username, password){ tryCatch({ username <- DBI::dbQuoteString(connection, username) + key <- DBI::dbQuoteString(connection, Sys.getenv("USER_DATA_KEY")) + pepper <- DBI::dbQuoteString(connection, Sys.getenv("PEPPER")) password <- DBI::dbQuoteString(connection, password) - user_id <- 'not connected' - user_id <- DBI::dbGetQuery(connection, glue::glue('SELECT DISTINCT user_id - FROM gen_management.accounts - WHERE username = {username} - AND password = {password};')) + + # get salt + salt <- as.character(DBI::dbGetQuery(connection, glue::glue("SELECT salt FROM gen_management.salt WHERE pgp_sym_decrypt(decode(username, 'hex'), {key}) = {username};"))[1,1]) + sterilized_salt <- DBI::dbQuoteString(connection, salt) + + q <- glue::glue("SELECT DISTINCT user_id + FROM gen_management.accounts + WHERE username = {username} + AND pgp_sym_decrypt(decode(password, 'hex'), {key}) = CONCAT({password}, {sterilized_salt}, {pepper});") + user_id <- DBI::dbGetQuery(connection, q) - if (is.null(toString(user_id)) || is.na(toString(user_id)) || toString(user_id) == ""){ + if (is.null(toString(user_id)) || is.na(toString(user_id)) || toString(user_id) == "" || nrow(user_id) == 0){ return(-999) - } else if (user_id == 'not connected') { - return('not connected') - } else { + } else { return(toString(user_id)) } }, error = function(cond){ @@ -48,14 +55,14 @@ get_user_id <- function(connection, username, password){ # returns study id associated with login credentials get_run_id <- function(connection, username, run_id){ tryCatch({ - + username <- DBI::dbQuoteString(connection, username) run_id <- DBI::dbQuoteLiteral(connection, run_id) - run_id <- DBI::dbGetQuery(connection, glue::glue('SELECT DISTINCT run_id + run_id <- DBI::dbGetQuery(connection, glue::glue("SELECT DISTINCT run_id FROM gen_management.accounts - WHERE username = {username} - AND run_id = {run_id};')) - + WHERE username = {username} + AND run_id = {run_id};")) + # test for duplicate ids if (length(run_id) == 1){ return(toString(run_id)) @@ -76,10 +83,12 @@ get_email_address <- function(connection, username){ tryCatch({ username <- DBI::dbQuoteString(connection, username) + key <- DBI::dbQuoteString(connection, Sys.getenv("USER_DATA_KEY")) + email <- NULL - q <- glue::glue('SELECT DISTINCT email + q <- glue::glue("SELECT DISTINCT email FROM gen_management.accounts - WHERE username = {username};') + WHERE username = {username};") email <- DBI::dbGetQuery(connection, q) if (is.null(email)) { @@ -100,20 +109,38 @@ get_email_address <- function(connection, username){ add_user <- function(connection, username, run_id, email, password, original_username, original_run_id) { tryCatch({ username <- DBI::dbQuoteString(connection, username) - q <- glue::glue('SELECT (EXISTS (SELECT FROM gen_management.accounts WHERE username = {username}))::INTEGER;') + key <- DBI::dbQuoteString(connection, Sys.getenv("USER_DATA_KEY")) + + q <- glue::glue("SELECT (EXISTS (SELECT FROM gen_management.accounts WHERE username = {username}))::INTEGER;") + exists <- DBI::dbGetQuery(connection, q)[1,1] if (exists == 1){ print('This username already exists, please choose something else.') return('Username already exists') } else if (exists == 0){ + + # salt + salt <- sodium::bin2hex(sodium::random(8)) + sterilized_salt <- DBI::dbQuoteString(connection, salt) + pepper <- DBI::dbQuoteString(connection, Sys.getenv("PEPPER")) + # add salt for future use + q <- glue::glue("INSERT INTO gen_management.salt (username, salt) VALUES (encode(pgp_sym_encrypt({username}, {key}), 'hex'), {sterilized_salt});") + DBI::dbGetQuery(connection, q) + + # sterilize values run_id <- DBI::dbQuoteString(connection, run_id) - email <- DBI::dbQuoteString(connection, email) password <- DBI::dbQuoteString(connection, password) + email <- DBI::dbQuoteString(connection, email) original_username <- DBI::dbQuoteString(connection, original_username) original_run_id <- DBI::dbQuoteString(connection, original_run_id) - q <- glue::glue("INSERT INTO gen_management.accounts ( username, password, user_id, run_id, email, o_username, o_run_id) VALUES ({username}, {password}, EXTRACT(EPOCH FROM NOW()), {run_id}, {email}, {original_username}, {original_run_id});") + + #insert username + q <- glue::glue("INSERT INTO gen_management.accounts ( username, password, user_id, run_id, email, o_username, o_run_id) + VALUES ({username}, encode(pgp_sym_encrypt(CONCAT({password}, {sterilized_salt}, {pepper}), {key}), 'hex'), EXTRACT(EPOCH FROM NOW()), {run_id}, {email}, {original_username}, {original_run_id});") DBI::dbGetQuery(connection, q) + print(glue::glue('Added username: {username}')) + return('User added') } else { return('Error occured') @@ -131,17 +158,25 @@ add_run <- function (connection, username, run_id, password, original_run_id ){ tryCatch({ username <- DBI::dbQuoteString(connection,username) run_id <- DBI::dbQuoteString(connection,run_id) - password<-DBI::dbQuoteString(connection, password) - email <- get_email_address(connection=connection, username = username) + password <- DBI::dbQuoteString(connection,password) + email <- DBI::dbQuoteString(connection, get_email_address(connection=connection, username = username)) email <- DBI::dbQuoteString(connection, email) + key <- DBI::dbQuoteString(connection, Sys.getenv("USER_DATA_KEY")) + pepper <- DBI::dbQuoteString(connection, Sys.getenv("PEPPER")) q <- glue::glue("SELECT DISTINCT o_username FROM gen_management.accounts - WHERE username={username};") - o_un <- DBI::dbGetQuery(connection, q)[,1] + WHERE username = {username};") + + salt <- as.character(DBI::dbGetQuery(connection, glue::glue("SELECT salt FROM gen_management.salt WHERE pgp_sym_decrypt(decode(username, 'hex'), {key}) = {username};"))[1,1]) + sterilized_salt <- DBI::dbQuoteString(connection, salt) + o_un <- DBI::dbGetQuery(connection, q)[1,1] original_username <- DBI::dbQuoteString(connection, o_un) original_run_id <- DBI::dbQuoteString(connection, original_run_id) user_id <- get_user_id(connection=connection, username = username, password=password) - q <- glue::glue("INSERT INTO gen_management.accounts ( username, user_id, password, run_id, email, o_username, o_run_id) VALUES ({username},{user_id},{password},{run_id},{email},{original_username},{original_run_id});") + + #insert new run + q <- glue::glue("INSERT INTO gen_management.accounts ( username, user_id, password, run_id, email, o_username, o_run_id) + VALUES ({username}, {user_id}, encode(pgp_sym_encrypt(CONCAT({password}, {sterilized_salt}, {pepper}), {key}), 'hex'), {run_id}, {email}, {original_username}, {original_run_id});") DBI::dbGetQuery(connection, q) }, error = function(cond){ c <- toString(cond) diff --git a/safer_streets_priority_finder/env_variables.R b/safer_streets_priority_finder/env_variables.R index 5a821ea..9684979 100644 --- a/safer_streets_priority_finder/env_variables.R +++ b/safer_streets_priority_finder/env_variables.R @@ -11,8 +11,14 @@ Sys.setenv(SSPF_AMAZON_USERNAME="") Sys.setenv(SSPF_AMAZON_DATABASE="") +Sys.setenv(AWS_ACCESS_KEY_ID="") + Sys.setenv(AWS_SECRET_ACCESS_KEY="") Sys.setenv(AWS_DEFAULT_REGION="") -Sys.setenv(S3_BUCKET="") \ No newline at end of file +Sys.setenv(S3_BUCKET="") + +Sys.setenv(PEPPER="") + +Sys.setenv(USER_DATA_KEY="") \ No newline at end of file