From 4e96813e30afccb58452329e49d78734500b0740 Mon Sep 17 00:00:00 2001 From: HenriKajasilta Date: Tue, 24 Jan 2023 16:13:58 +0200 Subject: [PATCH 1/7] RData --- .RData | Bin 2627 -> 19173 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/.RData b/.RData index 3ced8e45466ccf9ac17faac43d668ea06c2c28d1..4aa155aabfa1bbdf41f4bb79af901aa2f2f80099 100644 GIT binary patch literal 19173 zcmeGj2|QH!e;m0Y%2~F0q9WHAgl>t7R;{AaF+DR6&m3=>c|%I~o!VB2O>`jAeW`!a zeXuD?saA)mwvtV42VMTZXWrAiX;|%UyX}7Xe4gL?eShEkch39%z5&A~IO|N%VK5kK z40TmihFUxD%4ioj&d1)J0U)5F!cb>u69{5N!eFQxHiDW;HKOhU9s}^0k*J#Cus9Nt z;L588m^cg;q8zpW#t|_J^GP%f0TzV{!^m25SPHybiKY{Zh;fvU&P2qYr_>)4rx}GH z+>f?=D!n<{^=Y5GWK1_%=C_rh={nK_EOF zfrJ>2C}ZR-k%~iM4ni;?@ER?HBpfk}bHah&LNPILq5z8oS^*Sd4Umw0EaZ9HK`>u} zK~f=4h(!q@Sb#}|)LPk701KsJq|t*?F)$Gd6=MPjxOOI3PXHJd0Agj@(QNq>75W5M z#)!etZUBE^NYP8#K0#7Yjb8#t@&5BAv3r@3b3>K%s+v#0@TOPqF=T7gHb}HG7$4*w zV(V+3n85s6Fyysv?p=N(?W$DqI4(%%vM`6f~ZG;6A=yK}Ri{YyGe!6c&=_L;?f6natl?L^T7vM~@rf9q@O2Y@~Fi%9eDePBOCDrWBK6 zLzPOAlmaOVs-z)(!OA~BCRAOSP0ImgJypsKCoulgE>M_yl=W08vt9om_!duTK$Wy! z_}hU>1=3Xdf|V~cQD_<~HLyjX(ncE3FIZtP^uWwDn+N_84~X9v%SyEjS*dO*D;YP* z@~*7Zu_j8{dvAU4Iu|^b$wwEI#Ki#OA>P}Ar=^39!sMaZtJFPz6c{hWKzI-Y+ra$+ z5b`5pj8se#K){s(h=U1nBG?ClY$y()5(va4r2-J4!^2@5a%J`;!gE}4G(_S93@^x< zJeWyj3?!%omk@XyOd!G}IG~QgFfJz?6#;%Az9~WZa2P^F<|Gmu;2Y}jN0#%zoe7mL zKB&-#xOo8aU_KAUB}gO;`TN=PVWAL1aS%xqLSmSQfH$PS7CjX=KSR0bbEm2oNq0tZPE0?G)O5QItvDC_`@MSue$0V}B#0{1M0 zm;gp4;8q4uCYm34DwpIZ<$>6w5aMBC9s&yls6+yTNTvk%7v)Pa9#JP$6Gy;8f&vyo zKxQ--5elPaloEsoL=);td9V~TK)?<{6nJYwmC&R)oZLw6BnjR?A>twkWE}!afRlko z_`owDrV7HKHbe(}5)l=NF|L#Ya6_USPNCX#ErOiUG)77)D!+GbXj&P*;PRpB^id0% zj&$RiRH4sS8pUT-fbpM&-=x47^o0tzxH%%R8+f12j>stb8RqN>iu& zmq&$yk+dG7cfJCq(ncEj?^V9WNuppR%><plU=k-(RM;uK;()t2xF;yK4U?c0B2(&;>$jW+DO=q`B>z~Q*|zg0Fdtnjfjn{ zY$6kjN_NsE)6&?m7=cOLCKyMIi70vs4+L%mAPPj$n^Ev+A|Z`U)woe4oe=?He{5uj zvZJW1tWGkp7aPVYLPco;3xg3UL+uQPC>)Y6dB0hMY&Rh4Ujnq;Te*;8-?)E zb`T|EbEDWehBsyBb|J77-9y7L`_xIac727LPm~AA;GJSRuo-|8Fc1r3Q_ckr6LLs8 z6S;N{EDphh@~vIugc0E-BF~sD!K7ji)k9`-7_dmhClZq7`^rQHY#gn?wIV#6O;C{1 zY1g<2H?e7HdSRnLb$9V!P?k7Msn!ZJFF`EYdQ)Ps{C=7)a<8vk`vd#AuO~ z4oFi6eJ8i#kPx|bNl%u_P9IQ4B#<`8$=>TowJA<*U9y2Th~$QWEEbBhi6xihrAH>8 z(^k)pvS4WAkYh_FAaYHOo5m3-!T8b;J|aIN>DmA7ID8Q2Cf9T-QAY1nR1a84T-mpxH|sqgcDy zgP#TLyfAZD_?f;mPbkO_!oV|Coqhz8@L!{!YrKooAm)^=UJK*~pA%Pq+SRHF5W<^qyK}%UEj>l?CU1GAtdf$G*Z}I_`Dv@71q27&%4N zuSj~d(s#!epS|w8ue$j~pGVYic8~DEN#>!mUQFRkU$QcA#&DJZ8ZmvOO6CdZaa@=b zdJuz0bPi^-G}e#Zg{1KoMy}GCT*F!sQ?mS0pQPM&aVz$!vmWd4(bem*lDP{yy89^AvLgCMdZ}01554jS^fP$;I&7`Q9X6$g%#}wZN(GBNnu(6 zHFeVXNte3`Tm)+kv{%9@v)&*^YRItFRU68u)o5i6L4%Fb{2Z60x0_#<428Ys=3H79 zH>Wr|sqP@Y#Wd8ktZSDyJG5Lci!S_#4%E44H>4fAr?38S=aCl@H;pX(+0r@fOxU(^ z*C%O1^`3j?+{FiLRBfG@ZgF~V=ZFe5HRc#2aS+$GleR_ej{g0V=C9fZ^%6a4uigHs z8$Z}8&?&U1s@V2edS0KRs`1IMMQL`s?#Fs@IN4S5V0rkoKnRO}X8*4D=p_S&jI~wk6gOtr-g(p3&aiD*HPmCZm3V!D z=7FKMdBH}{Qjo>j$-G;(Kg3LbsuO(ob;XvT#W%j+h@h2)dNmfs{mw`0-PX8Y=P}!N z+3D)8Z`5}s*R6?V4H=)$;r5ERxLsuyJh}9ux-KK2eoe;#%zc&hoz`>IJ{0d^;Ss$a zMXWQ7VNPGNZ^(-5>YH~{`>74Q*ZH|Kj$KNW^zb`-hrP%Ywh|7%b$lNK)h)fzL&s|C zg;jYkn1QB_zCG%=CF?zlYnLAhSkUii@2N<>sXzJ(nRuD|xbEko%J>`G@N28Hx362i zas5xi1s!VpWba?hG}>=C67NvE zG`aBdW#P)0DKk6U=`nTlez`hn)cr%9F~Uklz0`{sbMK__H*Z~12UsSApFNU( zCpHZk93jn(XV%n{ z*2O}{W3!AO9(1&{UOd_<>+$Od)ja5zjD<+_l=oVh zZd0;?{3n=Ti0g2h_vKX$HBL#9Z|`%S4LcKjBhu#a4AJ;wr;WQC`pi1f@T1;Fue7Tk z{+oJkUA@NE+ca}7HrV)PuRZU>5Ax@YoLfCU@ZpjtlX5K`FMB_HnRBN$*E`8`UDolk zq>7l5djI^4{XrM2Q?96Jt<-l5A9{C(`H^?lmrusM6 z^}F&4ssntB)l^Epb&Edywn6*3#)R>&+-o(SIo3^5YuAthd))kGhKkL`sJNn6*1LHL z#qabcUJN>S3_Ee4a2jL7nUqPaiSKnkLGt)3eL`aAlQY{w*8l!t9XIo~myX)b{uH^bX1Q#`3r1c|C2|P?uj^AMk8#(E9l= z>&1P14n^ox-nPAwK6l%XA3RV$+aV*4`c;%i_gOP=#m`zbm51;vmg-L5yDdr8%^Z^E zesoS4bJMRpY|fg?P^w#pfT|G=-0icB>k>V>*iN`Q3);*{Prv=$2xGyFsYg1$`_8R@ ztfN68s zNcJ^vz5VAmFR>X=>-g|mxBN>P45OoZYRBi?9&^|hUAt~j|2G}sLHFm4Sv{Ox>A>wQLv$ zW?8W(GqC-Gt#7u8`GTZXN7h!{x$?mv{fv`yLV!hYc73VeGsl?F@lyR2qK=Cexy*W! zur}^-xAQKT|2D}%eU(GyMy6HAZUwyB_gje6G`^;$^mOWh`j9oKm3HOL3BPUe+y1{Q zx964k<_E0$fZN^I<+smDUHreQ{u2s4gkf7<3*%hATez$)g}Lxr_xtPfjCyKWa^qai zA5R@%_ESz#g}2b~`s{1xm`=CP!9Dk{X~>UMGnqB%q~mMN74PQfpS{U2KVO->Q0-L5 zilBmxdlTH9>#rtO3`#lHYmvF5gXFe}uk8_P+ z@zn~!wC>mR3VK!>uYBuw?^^1`6GpE)+31{Te`3aw1BSoFoZLLAKbksulkL&aU}J*~ zr-qrk-Y6;zIdb?gYpG^vKbHfW-kUEhW^?^(%Io^=*3LCumi2vyE!KTjmhknn*{Av# z-E;ChE_6iSR9I;Tu<<3L{uiJ7rL0pAz7U1E=Iq&U#-Vul_^~e&E0Z0+;qSPw`F^*K z->XGgmv(2}89m>U*NvHSZ@anZwGHQGr_5s+c?kyGtp4w(-YbkbwJn`JctK1>WJx4( GnEXF>k4mKg delta 12 TcmaDlmGQ911ntdd9VEB_B~t|O From 459465cdb078dcb16f15eb061c1768220713259d Mon Sep 17 00:00:00 2001 From: HenriKajasilta Date: Wed, 28 Jun 2023 13:17:06 +0300 Subject: [PATCH 2/7] Added a condition that a certain user is able to see several sites without being an admin --- R/app_server.R | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index eea0f4d..76428e7 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -56,15 +56,26 @@ app_server <- function(input, output, session) { if (dp()) message("auth_result$user changed") if (auth_result$admin == "FALSE") { - - updateSelectInput(session, "site", selected = auth_result$user) - shinyjs::disable("site") + # Create a new user that has access to the Carbon action sites. + if (auth_result$user == "ca_user") { + + shinyjs::enable("site") + shinyjs::show("site") + # Subset of site choices for the third user + site_choices <- sites[sites$site_type %in% c('Advanced CarbonAction Site','CarbonAction Site'),]$site + + updateSelectInput(session, "site", choices = site_choices, selected = auth_result$user) + } else { + + updateSelectInput(session, "site", selected = auth_result$user) + shinyjs::disable("site") + } updateTextInput(session, "uservisible", value = auth_result$user) shinyjs::disable("uservisible") - # shinyjs::show("usevisible") + # shinyjs::show("uservisible") } else { shinyjs::enable("site") shinyjs::show("site") From 7748b8170fff7054ec23d62665926f14747d416b Mon Sep 17 00:00:00 2001 From: HenriKajasilta Date: Wed, 5 Jul 2023 15:43:52 +0300 Subject: [PATCH 3/7] Added new user options and now downloading the management data works for them too --- R/app_server.R | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 76428e7..57c9037 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -65,6 +65,15 @@ app_server <- function(input, output, session) { site_choices <- sites[sites$site_type %in% c('Advanced CarbonAction Site','CarbonAction Site'),]$site updateSelectInput(session, "site", choices = site_choices, selected = auth_result$user) + } else if (auth_result$user == "valio_user") { + + shinyjs::enable("site") + shinyjs::show("site") + # Subset of site choices for the third user + site_choices <- sites[grepl("Valio Carbo", sites$site_type),]$site + + updateSelectInput(session, "site", choices = site_choices, selected = auth_result$user) + } else { updateSelectInput(session, "site", selected = auth_result$user) @@ -91,13 +100,13 @@ app_server <- function(input, output, session) { ################ # Module for download server, need to decide if ui is separated to - # different functions, if more download buttons in required + # different functions, if more download buttons is required mod_download_server_inst("download_ui_1") - mod_download_server_table("event_table", auth_result$user) + mod_download_server_table("event_table", user_auth = reactive(input$site)) - mod_download_server_json("json_zip", auth_result$user) + mod_download_server_json("json_zip", user_auth = reactive(input$site)) From fbdfdc1796b5384c22b036069851bb5f0eb07524 Mon Sep 17 00:00:00 2001 From: HenriKajasilta Date: Wed, 5 Jul 2023 15:45:12 +0300 Subject: [PATCH 4/7] Changed the checking of a user/site to interactive, so it will enable users who have access to several sites to download the management data --- R/mod_download.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/mod_download.R b/R/mod_download.R index 0155a5d..a7eb776 100644 --- a/R/mod_download.R +++ b/R/mod_download.R @@ -130,6 +130,7 @@ mod_download_json <- function(id, label) { #' mod_download_server_table <- function(id, user_auth, base_folder = json_file_base_folder()) { + stopifnot(is.reactive(user_auth)) moduleServer(id, function(input, output, session){ ns <- session$ns @@ -152,7 +153,7 @@ mod_download_server_table <- function(id, user_auth, base_folder = json_file_bas file_path <- base_folder if(dp()) message("Checking current user") - user <- user_auth + user <- user_auth() } # Create the file path based on the production status and the user file_path <- file.path(file_path, user) @@ -198,6 +199,7 @@ mod_download_server_table <- function(id, user_auth, base_folder = json_file_bas mod_download_server_json <- function(id, user_auth, base_folder = json_file_base_folder()) { + stopifnot(is.reactive(user_auth)) moduleServer(id, function(input, output, session){ ns <- session$ns @@ -223,7 +225,7 @@ mod_download_server_json <- function(id, user_auth, base_folder = json_file_base file_path <- base_folder if(dp()) message("Checking current user") - user <- user_auth + user <- user_auth() } # Create the file path based on the production status and the user file_path <- file.path(file_path, user) From cb0d12864a74f35e8d36468c209cbd89a2a9c20c Mon Sep 17 00:00:00 2001 From: HenriKajasilta <92798719+HenriKajasilta@users.noreply.github.com> Date: Wed, 5 Jul 2023 16:53:09 +0300 Subject: [PATCH 5/7] Update R-CMD-check.yaml Updated r-lib/actions/setup-r@v1 to v2 --- .github/workflows/R-CMD-check.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 65e8daa..cd53d35 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -22,7 +22,7 @@ jobs: steps: - uses: actions/checkout@v2 - uses: r-lib/actions/setup-pandoc@v2 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 - name: Install dependencies run: | install.packages(c("remotes", "rcmdcheck")) From bd70685f35c1f35c0298563bf1a70b27b74bd98e Mon Sep 17 00:00:00 2001 From: HenriKajasilta Date: Wed, 5 Jul 2023 17:07:59 +0300 Subject: [PATCH 6/7] Updated r-lib setup version --- .github/workflows/R-CMD-check.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 65e8daa..cd53d35 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -22,7 +22,7 @@ jobs: steps: - uses: actions/checkout@v2 - uses: r-lib/actions/setup-pandoc@v2 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 - name: Install dependencies run: | install.packages(c("remotes", "rcmdcheck")) From 3a5b78bf69283b319e2f4594e2dcae553e67a8c7 Mon Sep 17 00:00:00 2001 From: HenriKajasilta Date: Wed, 5 Jul 2023 17:08:28 +0300 Subject: [PATCH 7/7] Fixed the tests for downloading data --- tests/testthat/test-download.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-download.R b/tests/testthat/test-download.R index 5d38469..fcb58bd 100644 --- a/tests/testthat/test-download.R +++ b/tests/testthat/test-download.R @@ -7,15 +7,17 @@ test_that("is download functional", { expect_true(file.info(output$report)$size > 10000) }) + site <- reactive("qvidja") + # Check that file exist when downloading csv - testServer(mod_download_server_table, args = list(user_auth = "qvidja"), { + testServer(mod_download_server_table, args = list(user_auth = site), { expect_true(file.exists(output$eventtable)) expect_true(file.size(output$eventtable) > 70) }) # Check that file exist when downloading zip - testServer(mod_download_server_json, args = list(user_auth = "qvidja"), { + testServer(mod_download_server_json, args = list(user_auth = site), { expect_true(file.exists(output$eventjson)) expect_true(grepl(".zip", output$eventjson))