Merge pull request #5 from tooledesign/hashing

Hashing
tooledesign · Sep 1, 2021 · 1100a5e · 1100a5e
2 parents 8c3a4a6 + 78ba40e
commit 1100a5e
Show file tree

Hide file tree

Showing 8 changed files with 98 additions and 44 deletions.
diff --git 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 → general/build_psql_db.sql b/build_psql_db.sql → 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 → general/national_fclass_priors.csv b/national_fclass_priors.csv → general/national_fclass_priors.csv
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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="")
+Sys.setenv(S3_BUCKET="")
+
+Sys.setenv(PEPPER="")
+
+Sys.setenv(USER_DATA_KEY="")