diff --git a/app/app.R b/app/app.R index 01a2b55..7d9199b 100644 --- a/app/app.R +++ b/app/app.R @@ -14,24 +14,65 @@ source("routing_module.R",encoding="utf-8") ui <- fluidPage( + useShinyjs(), + tags$head( + tags$script(src="js.cookie.js") + ), + # tags$script('var cookie = Cookies.get(\'token\'); + # $(document).on("shiny:sessioninitialized",function(event){ + # Shiny.onInputChange("token", cookie);});')), + uiOutput("logged"), + - fluidRow( - useShinyjs(), - inlineCSS(list(.clicked = "background-color: #008375 !important")), - column(12, - navbarPage("", - tabPanel(a("TakeCareApp",id='takeCareApp',class = "tab-link", href = route_link("home"))), - tabPanel(a("Firmy",id="tab1",class = "tab-link", href = route_link("profil"))), - tabPanel(a("O nas",id="tab2",class = "tab-link", href = route_link("about"))), - tabPanel(a("Zaloguj",id="tab3",class="tab-link", href = route_link("login"))), - tabPanel(a("Rejestracja",id="tab4",class="tab-link", href = route_link("register")))), - - )), router$ui) server <- shinyServer(function(input, output, session){ + + output$logged<-renderUI({ + + + if(is.null(input$token)){ + fluidRow( + + inlineCSS(list(.clicked = "background-color: #008375 !important")), + column(12, + navbarPage("", + tabPanel(a("TakeCareApp",id='takeCareApp',class = "tab-link", href = route_link("home"))), + tabPanel(a("Firmy",id="tab1",class = "tab-link", href = route_link("profil"))), + tabPanel(a("O nas",id="tab2",class = "tab-link", href = route_link("about"))), + tabPanel(a("Zaloguj",id="tab3",class="tab-link", href = route_link("login"))), + tabPanel(a("Rejestracja",id="tab4",class="tab-link", href = route_link("register")))) + + + + ) + ) + }else{ + fluidRow( + + inlineCSS(list(.clicked = "background-color: #008375 !important")), + column(12, + navbarPage("", + tabPanel(a("TakeCareApp",id='takeCareApp',class = "tab-link", href = route_link("home"))), + tabPanel(a("Firmy",id="tab1",class = "tab-link", href = route_link("profil"))), + tabPanel(a("O nas",id="tab2",class = "tab-link", href = route_link("about"))), + tabPanel(a("Wyloguj",id="tab3",class = "tab-link")), + tabPanel(a("Profil",id="tab4",class="tab-link", href = route_link("profil")))) + + + + ) + ) + } + + + + + + }) + shinyjs::onclick(id="takeCareApp",expr = { shinyjs::removeCssClass(id="tab1",class = "clicked") @@ -55,10 +96,18 @@ shinyjs::onclick(id="tab1",expr = { }) shinyjs::onclick(id="tab3",expr = { - shinyjs::addCssClass(id="tab3",class = "clicked") - shinyjs::removeCssClass(id="tab2",class = "clicked") - shinyjs::removeCssClass(id="tab1",class = "clicked") - shinyjs::removeCssClass(id="tab4",class = "clicked") + if(is.null(input$token)){ + + shinyjs::addCssClass(id="tab3",class = "clicked") + shinyjs::removeCssClass(id="tab2",class = "clicked") + shinyjs::removeCssClass(id="tab1",class = "clicked") + shinyjs::removeCssClass(id="tab4",class = "clicked") + }else{ + shinyjs::runjs( 'Cookies.remove(\'token\'); + + Shiny.onInputChange("token", null); + window.location.replace(\'/#!/login\');') + } }) shinyjs::onclick(id="tab4",expr = { diff --git a/app/connection_module.R b/app/connection_module.R new file mode 100644 index 0000000..3cd8992 --- /dev/null +++ b/app/connection_module.R @@ -0,0 +1,76 @@ +library(dplyr) +library(RSQLite) +library(digest) + + +library(RSQLite) + + +init<-function(){ + db <- dbConnect(SQLite(), dbname="db.sqlite") + rs<-dbSendQuery(conn = db, + "CREATE TABLE if not exists users + (name TEXT, + surname TEXT, + mail TEXT, + age TEXT, + gender TINYINT, + login TEXT, + pass TEXT, + role TINYINT)") + dbClearResult(rs) + dbDisconnect(db) +} + + +register<-function(data){ + db <- dbConnect(SQLite(), dbname="db.sqlite") + pass_enc = digest::digest(data$haslo,algo="sha256") + tmp = paste("VALUES ('",paste(data$name,data$surname,data$mail,data$age,data$gender,data$username,pass_enc,0,sep="','"),"');") + print(tmp) + + query=paste("INSERT INTO users ( name,surname,mail,age ,gender ,login , pass ,role ) ",tmp) + print(query) + rs1<-dbSendQuery(db,query) + + + dbClearResult(rs1) + + + return(TRUE) + +} + +login<-function(data){ + db <- dbConnect(SQLite(), dbname="db.sqlite") + pass_enc = digest::digest(data$pass,algo="sha256") + tmp = paste("login='",data$login,"' AND ","pass='",pass_enc,"';",sep="") + # query = "SELECT * FROM users" + query = paste("SELECT COUNT(*) as 'FOUND' FROM users WHERE ",tmp) + print(query) + rs1<-dbSendQuery(db,query) + # print(dbFetch(rs1)) + result = dbFetch(rs1)$FOUND + print(result) + dbClearResult(rs1) + dbDisconnect(db) + return(result) + +} + +findLogin<-function(login){ + db <- dbConnect(SQLite(), dbname="db.sqlite") + tmp = paste("login='",login,"';",sep="") + # query = "SELECT * FROM users" + query = paste("SELECT COUNT(*) as 'FOUND' FROM users WHERE ",tmp) + print(query) + rs1<-dbSendQuery(db,query) + # print(dbFetch(rs1)) + result = dbFetch(rs1)$FOUND + print(result) + dbClearResult(rs1) + dbDisconnect(db) + return(result) + +} + diff --git a/app/db.sqlite b/app/db.sqlite new file mode 100644 index 0000000..37f826c Binary files /dev/null and b/app/db.sqlite differ diff --git a/app/login_module.R b/app/login_module.R index f03406f..54ceba1 100644 --- a/app/login_module.R +++ b/app/login_module.R @@ -4,10 +4,14 @@ library(ggplot2) library(plotly) library(DT) +source("connection_module.R",encoding="utf-8") + loginUI <- function(id) { ns <- NS(id) fluidPage( + useShinyjs(), tags$head( + tags$script(src="js.cookie.js"), tags$style(HTML(" @import url('//fonts.googleapis.com/css?family=Lobster|Cabin:400,700'); @import url('//fonts.googleapis.com/css2?family=Fjalla+One'); @@ -22,7 +26,8 @@ loginUI <- function(id) { fluidRow(column(12, wellPanel( textInput("login", label = strong("Login")), - textInput("pass", label = strong("Haslo")), + passwordInput("pass", label = strong("Haslo")), + uiOutput("loginErr"), actionButton('loginBtn',"Zaloguj") ))%>% tagAppendAttributes(id = 'column-login') @@ -39,7 +44,69 @@ loginUI <- function(id) { ) } -loginServer <- function(input, output) { +loginServer <- function(input, output,session) { + + isCorrect <- eventReactive(input$loginBtn, { + tmp<-data.frame(login=input$login,pass=input$pass) + number<-login(tmp) + print(number) + if(number!=0){ + shinyjs::runjs( 'Cookies.set(\'token\', \'loggedIn\', { expires: 7 }); + + var cookie = Cookies.get(\'token\'); + Shiny.onInputChange("token", cookie); + window.location.replace(\'/#!/profil\');') + + TRUE + + + + }else{ + FALSE + } + + + }) + + + output$loginErr<-renderUI({ + if (isCorrect()==TRUE){ + p("OK",style="color:white;text-align:center;") + }else{ + p("Uzytkownik nie istnieje lub wprowadzono bledne dane",style="color:yellow;text-align:center;") + } + + }) + + # observeEvent(input$loginBtn,{ + # tmp<-data.frame(login=input$login,pass=input$pass) + # number<-login(tmp) + # print(number) + # if(number!=0){ + # shinyjs::runjs( 'Cookies.set(\'token\', \'loggedIn\', { expires: 7 }); + # + # var cookie = Cookies.get(\'token\'); + # Shiny.onInputChange("token", cookie); + # window.location.replace(\'/#!/profil\');') + # + # + # + # }else{ + # + # } + # + # + # }) + + observe({ + if(((session$clientData)$url_hash=="#!/login") & (!is.null(input$token) & length(input$token)>0 )){ + + print("dziala") + shinyjs::runjs('window.location.replace(\'/#!/home\');') + } + }) + + diff --git a/app/profil_module.R b/app/profil_module.R index 8cb10ff..f6e2da2 100644 --- a/app/profil_module.R +++ b/app/profil_module.R @@ -7,7 +7,10 @@ library(DT) profilUI <- function(id) { ns <- NS(id) fluidPage( + useShinyjs(), tags$head( + tags$script(src="js.cookie.js"), + tags$style(HTML(" @import url('//fonts.googleapis.com/css?family=Lobster|Cabin:400,700'); @import url('//fonts.googleapis.com/css2?family=Fjalla+One'); @@ -20,21 +23,8 @@ profilUI <- function(id) { # App title ---- - fluidRow( - column(3, - tags$div("Panel sterowania") %>% tagAppendAttributes(class="panel-title") - - )%>% tagAppendAttributes(id = 'column-panel'), - column(9, - tabsetPanel(type = "tabs", - tabPanel("Zakładka 1", tags$div(plotlyOutput("plot1",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')), - tabPanel("Zakładka 2", tags$div(plotlyOutput("plot2",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')), - tabPanel("Zakładka 3", tags$div(plotlyOutput("plot3",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')), - tabPanel("Zakładka 4", tags$div(plotlyOutput("plot4",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')), - tabPanel("Zakładka 5", tags$div(DT::dataTableOutput("table1",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')) - - ))%>% tagAppendAttributes(id = 'column-content') - ) %>% tagAppendAttributes(id = 'row-content'), + uiOutput("afterLogin"), + @@ -47,7 +37,47 @@ profilUI <- function(id) { )} -profilServer <- function(input, output) { +profilServer <- function(input, output,session) { + + + + + observe({ + if(((session$clientData)$url_hash=="#!/profil") & (is.null(input$token) | length(input$token)<=0 )){ + + print("dziala") + shinyjs::runjs('window.location.replace(\'/#!/home\');') + } + }) + + + + output$afterLogin<-renderUI({ + if(!is.null(input$token) & length(input$token)>0 ){ + + + + fluidRow( + column(3, + tags$div("Panel sterowania") %>% tagAppendAttributes(class="panel-title") + + )%>% tagAppendAttributes(id = 'column-panel'), + column(9, + tabsetPanel(type = "tabs", + tabPanel("Zakładka 1", tags$div(plotlyOutput("plot1",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')), + tabPanel("Zakładka 2", tags$div(plotlyOutput("plot2",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')), + tabPanel("Zakładka 3", tags$div(plotlyOutput("plot3",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')), + tabPanel("Zakładka 4", tags$div(plotlyOutput("plot4",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')), + tabPanel("Zakładka 5", tags$div(DT::dataTableOutput("table1",height = "auto"))%>% tagAppendAttributes(class = 'content-wrapper')) + + ))%>% tagAppendAttributes(id = 'column-content') + ) %>% tagAppendAttributes(id = 'row-content') + }else{ + + } + + + }) output$plot1 <- renderPlotly({ diff --git a/app/register_module.R b/app/register_module.R index 1d43854..04a0d0c 100644 --- a/app/register_module.R +++ b/app/register_module.R @@ -3,11 +3,13 @@ library(magrittr) library(ggplot2) library(plotly) library(DT) - +connection <-source("connection_module.R",encoding="utf-8") registerUI <- function(id) { ns <- NS(id) fluidPage( + useShinyjs(), tags$head( + tags$script(src = "message-handler.js"), tags$style(HTML(" @import url('//fonts.googleapis.com/css?family=Lobster|Cabin:400,700'); @import url('//fonts.googleapis.com/css2?family=Fjalla+One'); @@ -19,34 +21,7 @@ registerUI <- function(id) { # App title ---- - fluidRow(column(12, - wellPanel( - textInput("name", label = strong("Imie")), - uiOutput("name"), - textInput("surname", label = strong("Nazwisko")), - p(textOutput("surname"),style="color:red;"), - textInput("mail", label = strong("Adres email")), - p(textOutput("mail"),style="color:red;"), - dateInput("age", label = strong("Data urodzenia"),value = "1970-01-01"), - p(textOutput("age"),style="color:red;"), - selectInput("gender", label = strong("Plec"), - choices = list("Żenska" = 0, "Meska" = 1), - selected = 0), - p(textOutput("gender"),style="color:red;"), - textInput("login", label = strong("Login")), - p(textOutput("login"),style="color:red;"), - textInput("pass", label = strong("Haslo")), - p(textOutput("pass"),style="color:red;"), - checkboxGroupInput("permission", label = strong("Wyrażam zgode"), - choices = list("Wyrażam zgode na przetwarzanie moich danych osobowych. *" = 1, "Oswiadczam ze jestem swiadom ze aplikacja TakeCareApp to narzedzie wspierajace diagnostyke i nie moze w pelni zastapic konsultacji medycznej z lekarzem. * " = 2), - ), - p(textOutput("permission"),style="color:red;"), - actionButton('loginBtn',"Zarejestruj") - - ))%>% tagAppendAttributes(id = 'column-login') - ) %>% tagAppendAttributes(id = 'row-register'), - - + uiOutput("regform"), fluidRow( @@ -58,30 +33,233 @@ registerUI <- function(id) { ) } -registerServer <- function(input, output) { +registerServer <- function(input, output,session) { result <-reactiveValues(name=NULL,surname=NULL,mail=NULL,age=NULL,gender=NULL,login=NULL,pass=NULL,permission=NULL) - - observeEvent(input$loginBtn,{ - result$name<-input$name - result$surname<-input$surname - result$mail<-input$mail - result$age<-input$age - result$gender<-input$gender - result$login<-input$login - result$pass<-input$pass - result$permission<-input$permission - + status <-reactiveValues(status=NULL,first=TRUE) + + observe({ + if(((session$clientData)$url_hash=="#!/register") & (!is.null(input$token) & length(input$token)>0 )){ + + print("dziala") + shinyjs::runjs('window.location.replace(\'/#!/home\');') + } + }) + + + getStatus <- eventReactive(input$submit, { + result$name<-input$name + result$surname<-input$surname + result$mail<-input$mail + result$age<-input$age + result$gender<-input$gender + result$username<-input$username + result$haslo<-input$haslo + result$permission<-input$permission + + + reg<-c(grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",result$name), + grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",result$surname), + grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",result$mail), + grepl("^([a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]+[0-9\\-\\_]*){5,20}$",result$username), + grepl("^([a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{5,}[0-9]{5,}[a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż0-9]*)+$",result$haslo)) + if(all(reg) & all(result$permission==c(1,2))){ + status$status = register(result) + status$first = FALSE + }else{ + + status$status = FALSE + } + + + + + + + }) + + + output$regform<-renderUI({ + if (status$first==TRUE){ + fluidRow(column(12, + wellPanel( + textInput("name", label = strong("Imie")), + uiOutput("name"), + textInput("surname", label = strong("Nazwisko")), + uiOutput("surname"), + textInput("mail", label = strong("Adres email")), + uiOutput("mail"), + dateInput("age", label = strong("Data urodzenia"),value = "1970-01-01"), + + selectInput("gender", label = strong("Plec"), + choices = list("Żenska" = 0, "Meska" = 1), + selected = 0), + + textInput("username", label = strong("Login")), + uiOutput("username"), + passwordInput("haslo", label = strong("Haslo")), + uiOutput("haslo"), + checkboxGroupInput("permission", label = strong("Wyrażam zgode"), + choices = list("Wyrażam zgode na przetwarzanie moich danych osobowych. *" = 1, "Oswiadczam ze jestem swiadom ze aplikacja TakeCareApp to narzedzie wspierajace diagnostyke i nie moze w pelni zastapic konsultacji medycznej z lekarzem. * " = 2), + ), + uiOutput("permission"), + actionButton("submit","Zarejestruj"), + uiOutput("btnResponse",style="color:yellow;") + + ))%>% tagAppendAttributes(id = 'column-login') + ) %>% tagAppendAttributes(id = 'row-register') + }else if(status$status==FALSE){ + + fluidRow(column(12, + wellPanel( + textInput("name", label = strong("Imie")), + uiOutput("name"), + textInput("surname", label = strong("Nazwisko")), + uiOutput("surname"), + textInput("mail", label = strong("Adres email")), + uiOutput("mail"), + dateInput("age", label = strong("Data urodzenia"),value = "1970-01-01"), + + selectInput("gender", label = strong("Plec"), + choices = list("Żenska" = 0, "Meska" = 1), + selected = 0), + + textInput("username", label = strong("Login")), + uiOutput("username"), + passwordInput("haslo", label = strong("Haslo")), + uiOutput("haslo"), + checkboxGroupInput("permission", label = strong("Wyrażam zgode"), + choices = list("Wyrażam zgode na przetwarzanie moich danych osobowych. *" = 1, "Oswiadczam ze jestem swiadom ze aplikacja TakeCareApp to narzedzie wspierajace diagnostyke i nie moze w pelni zastapic konsultacji medycznej z lekarzem. * " = 2), + ), + uiOutput("permission"), + actionButton("submit","Zarejestruj"), + uiOutput("btnResponse",style="color:yellow;") + + ))%>% tagAppendAttributes(id = 'column-login') + ) %>% tagAppendAttributes(id = 'row-register') + + }else{ + + + + delay(100, shinyjs::refresh()) + } + + }) + + output$btnResponse<-renderUI({ + + if (getStatus()==TRUE){ + p("OK",style="color:white;text-align:center;") + }else{ + p("Uzytkownik istnieje lub wprowadzono bledne dane",style="color:yellow;text-align:center;") + } + # i<-(input$loginBtn) + # if (runif(1, -1.0, 1.0)>0){ + + # }else{ + + # } + + + # result <- data.frame(name=input$name,surname=input$surname,mail=input$mail,age=input$age,gender=input$gender,login=input$login,pass=input$pass) + + # if(is.null(correct$status)){ + # p("NULL",style="color:yellow") + # }else + # status<-correct() + # if(status==FALSE){ + # p("Bład: Podaj poprawne dane",style="color:yellow") + # }else if(status==TRUE){ + # p("OK",style="color:yellow") + # }else{ + # print(status) + # p("OK",style="color:yellow") + # } + + }) + output$name<-renderUI({ - if (is.null(result$name)){ + s<-toString(input$name) + + if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$",s)==TRUE){ return() }else{ - p("Podaj prawdziwe dane",style="color:red;") + p("Bład: Imie powinno zaczynac sie od wielkiej litery, zawierac jedynie litery i miec dlugosc od 3 do 15 znaków",style="color:yellow") + } + + }) + + output$surname<-renderUI({ + s<-toString(input$surname) + + if (s=="" | grepl("^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$",s)==TRUE){ + return() + }else{ + p("Bład: Nazwisko powinno zaczynac sie od wielkiej litery, zawierac jedynie litery i miec dlugosc od 3 do 15 znaków",style="color:yellow") + + } + + }) + + output$mail<-renderUI({ + s<-toString(input$mail) + + if (s=="" | grepl("^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$",s)==TRUE){ + return() + }else{ + p("Bład: Mail powinien miec budowe adres@nazwa.domena",style="color:yellow") + + + } + + }) + + output$username<-renderUI({ + s<-toString(input$username) + if (s==""){ + return() + }else{ + tmps=s + number=findLogin(tmps) + + if ((grepl("^([a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]+[0-9\\-\\_]*){5,20}$",s)==TRUE) & number==0){ + return() + }else if(number!=0){ + p("Bład: Login jest zajety",style="color:yellow") + }else{ + p("Bład: Login powinien skladac si z liter i cyfr i miec dlugosc od 5 do 15 znaków",style="color:yellow") + } + } + + + }) + + output$haslo<-renderUI({ + s<-toString(input$haslo) + + if (s=="" | grepl("^([a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{5,}[0-9]{5,}[a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż0-9]*)+$",s)==TRUE){ + return() + }else{ + p("Bład: Haslo powinno skladac sie z co najmniej 5 liter i 5 cyfr od 10 znaków",style="color:yellow") + } + + }) + + output$permission<-renderUI({ + s<-input$permission + + if (is.null(s)){ + p("Zaakceptuj warunki korzystania z serwisu",style="color:yellow") + }else if(all(s==c(1,2))){ + return() + }else{ + p("Zaakceptuj warunki korzystania z serwisu",style="color:yellow") } }) diff --git a/app/www/js.cookie.js b/app/www/js.cookie.js new file mode 100644 index 0000000..8d6b9a8 --- /dev/null +++ b/app/www/js.cookie.js @@ -0,0 +1,8 @@ +/** + * Minified by jsDelivr using Terser v3.14.1. + * Original file: /npm/js-cookie@2.2.1/src/js.cookie.js + * + * Do NOT use SRI with dynamically generated files! More information: https://www.jsdelivr.com/using-sri-with-dynamic-files + */ +!function(e){var n;if("function"==typeof define&&define.amd&&(define(e),n=!0),"object"==typeof exports&&(module.exports=e(),n=!0),!n){var t=window.Cookies,o=window.Cookies=e();o.noConflict=function(){return window.Cookies=t,o}}}(function(){function e(){for(var e=0,n={};e