Merge pull request #53 from StatisMike/development

Development
StatisMike · Aug 29, 2022 · 422a393 · 422a393
2 parents 6172265 + a692e08
commit 422a393
Show file tree

Hide file tree

Showing 207 changed files with 3,799 additions and 3,244 deletions.
diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
@@ -4,7 +4,7 @@ on:
   push:
     branches: [main, master]
   pull_request:
-    branches: [main, master]
+    branches: [main, master, development]
   workflow_dispatch:
 
 name: test-coverage
@@ -23,6 +23,12 @@ jobs:
 
     steps:
       - uses: actions/checkout@v2
+
+      - if: runner.os == 'macos'
+        run: brew services start mongodb-community
+
+      - if: runner.os == 'linux'
+        run: sudo systemctl restart mongod
 
       - uses: r-lib/actions/setup-r@v1
         with:
@@ -31,7 +37,6 @@ jobs:
       - uses: r-lib/actions/setup-r-dependencies@v1
         with:
           extra-packages: covr
-          needs: shinytesting
 
       - name: Test coverage
         run: covr::codecov()

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: shiny.reglog
 Title: Optional Login and Registration Module System for ShinyApps
-Version: 0.5.0
+Version: 0.5.2
 Authors@R: 
     person(given = "Michal",
            family = "Kosinski",
@@ -39,16 +39,18 @@ Suggests:
     gmailr,
     googledrive,
     googlesheets4,
+    jsonlite,
     knitr,
+    mongolite,
     rmarkdown,
     RSQLite,
+    shinytest2,
     testthat (>= 3.0.0)
-Config/Needs/shinytesting: devtools, shinytest, withr
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.1
 VignetteBuilder: knitr
 Config/testthat/edition: 3
 URL: https://statismike.github.io/shiny.reglog/
diff --git a/NAMESPACE b/NAMESPACE
@@ -8,6 +8,7 @@ export(RegLogDemo)
 export(RegLogEmayiliConnector)
 export(RegLogGmailrConnector)
 export(RegLogGsheetConnector)
+export(RegLogMongoConnector)
 export(RegLogServer)
 export(RegLog_credsEdit_UI)
 export(RegLog_login_UI)
@@ -23,6 +24,7 @@ export(login_UI)
 export(login_server)
 export(logout_button)
 export(mailMessageAttachment)
+export(mongo_tables_create)
 export(password_reset_UI)
 export(register_UI)
 export(reglog_txt)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,11 @@
+# shiny.reglog 0.5.1
+
+- added experimental `RegLogMongoConnector` - connector to mongodb database
+- added `shinytest2`-based tests
+- fixed bugs:
+  - correct modal showing up with missing inputs on credentials change
+  - `RegLogGsheetConnector` able to save logs into googlesheet database
+
 # shiny.reglog 0.5.0
 
 With the release of v0.5.0 there are a lot of changes in the current implementation

diff --git a/R/DBI_connector.R b/R/DBI_connector.R
@@ -40,14 +40,16 @@ RegLogDBIConnector = R6::R6Class(
     },
     # check the connection, and reconnect
     db_check_n_refresh = function() {
-      tryCatch({
-        res <- DBI::dbSendQuery(private$db_conn, "SELECT TRUE;")
-        DBI::dbClearResult(res)
-        },
-        error = function(e) {
-          private$db_connect()
-        }
-      )
+    #   tryCatch({
+    #     res <- DBI::dbSendQuery(private$db_conn, "SELECT TRUE;")
+    #     DBI::dbClearResult(res)
+    #     },
+    #     error = function(e) {
+    #       private$db_connect()
+    #     }
+    #   )
+      if (!isTRUE(DBI::dbIsValid(private$db_conn)))
+        private$db_connect()
     },
     # method to input log into database
     input_log = function(message, direction, session) {
@@ -86,15 +88,17 @@ RegLogDBIConnector = R6::R6Class(
     #' @description Initialization of the object. Creates initial connection
     #' to the database.
     #' 
+    #' Requires `DBI` package to be installed.
+    #' 
     #' @param driver Call that specifies the driver to be used during all queries
     #' @param ... other arguments used in `DBI::dbConnect()` call
     #' @param table_names character vector. Contains names of the tables in the
     #' database: first containing user data, second - reset codes information,
     #' third (optional) - logs from the object. For more info check documentation
     #' of `DBI_database_create`.
-    #' @param custom_handlers named list of custom handler functions. Custom handler
-    #' should take arguments: `self` and `private` - relating to the R6 object
-    #' and `message` of class `RegLogConnectorMessage`. It should return
+    #' @param custom_handlers named list of custom handler functions. Every 
+    #' custom handler should take arguments: `self` and `private` - relating to 
+    #' the R6 object and `message` of class `RegLogConnectorMessage`. It should 
     #' return `RegLogConnectorMessage` object.
     #' @return object of `RegLogDBIConnector` class
     #' 
@@ -123,8 +127,6 @@ RegLogDBIConnector = R6::R6Class(
       private$db_tables <- table_names
       # initial connection to the database, checking if everything is all right
       private$db_connect()
-      # assign the unique ID for the module
-      self$module_id <- uuid::UUIDgenerate()
       # disconnect fron the database when not used
       private$db_disconnect()
     }

diff --git a/R/DBI_handlers.R b/R/DBI_handlers.R
@@ -120,7 +120,6 @@ DBI_register_handler = function(self, private, message) {
                                  create_time = db_timestamp())
 
     DBI::dbExecute(private$db_conn, query)
-    # DBI::dbSendQuery(private$db_conn, query)
 
     return(
       RegLogConnectorMessage(
@@ -142,6 +141,7 @@ DBI_register_handler = function(self, private, message) {
 #' @param self R6 object element
 #' @param private R6 object element
 #' @param message RegLogConnectorMessage which need to contain within its data:
+#' - account_id
 #' - password
 #' 
 #' It can also contain elements for change:
@@ -271,7 +271,6 @@ DBI_credsEdit_handler <- function(self, private, message) {
         )
     }
   }
-
   return(message_to_send)
 }
 

diff --git a/R/RegLogConnector.R b/R/RegLogConnector.R
@@ -26,10 +26,10 @@ RegLogConnector = R6::R6Class(
     #' types of `RegLogConnectorMessage`. Name of the element corresponds to 
     #' the 'type' that is should handle.
     #' @details You can specify custom handler functions as a named list passed
-    #' to `custom_handlers` arguments during object initialization. Custom handler
-    #' should take arguments: `self` and `private` - relating to the R6 object
-    #' and `message` of class `RegLogConnectorMessage`. It should return
-    #' return `RegLogConnectorMessage` object
+    #' to `custom_handlers` arguments during object initialization. Every custom
+    #' handler should take arguments: `self` and `private` - relating to the R6 
+    #' object and `message` of class `RegLogConnectorMessage`. It should return 
+    #' `RegLogConnectorMessage` object.
 
     handlers = list(
       ping = function(self, private, message) {
@@ -64,9 +64,9 @@ RegLogConnector = R6::R6Class(
 
     #' @description Initialization of the object. Sets up listener reactiveVal
     #' and initializes listening server module
-    #' @param custom_handlers named list of custom handler functions. Custom handler
-    #' should take arguments: `self` and `private` - relating to the R6 object
-    #' and `message` of class `RegLogConnectorMessage`. It should return
+    #' @param custom_handlers named list of custom handler functions. Every 
+    #' custom handler should take arguments: `self` and `private` - relating to 
+    #' the R6 object and `message` of class `RegLogConnectorMessage`. It should 
     #' return `RegLogConnectorMessage` object.
     #' 
     #' @return object of `RegLogConnector` class
@@ -81,11 +81,11 @@ RegLogConnector = R6::R6Class(
       if (!is.null(custom_handlers)) {
         ## checks if the custom_handlers are correct
             ## custom handlers should be a list
-        if (class(custom_handlers) == "list" &&
+        if (is.list(custom_handlers) &&
             ## all elements of it needs to be named
             all(sapply(names(custom_handlers), \(x) nchar(x) > 0)) &&
             ## all elements need to be of class 'function'
-            all(sapply(custom_handlers, \(x) "function" %in% class(x)))
+            all(sapply(custom_handlers, is.function))
             ) {
 
           for (handler_n in seq_along(custom_handlers)) {
@@ -140,7 +140,7 @@ RegLogConnector = R6::R6Class(
                        # receive the message
                        received_message <- self$listener()
                        # reacts only on certain objects passed to its listener
-                       req(class(received_message) == "RegLogConnectorMessage" &&
+                       req(is.RegLogConnectorMessage(received_message) &&
                              received_message$type %in% names(self$handlers))
                        isolate({
                          # save received message to the logs
@@ -211,3 +211,8 @@ RegLogConnectorMessage <- function(
   return(x)
 
 }
+
+#' @rdname RegLogConnectorMessage
+#' @param x Any R object
+is.RegLogConnectorMessage <- function(x)
+  inherits(x, "RegLogConnectorMessage")
diff --git a/R/RegLogServer.R b/R/RegLogServer.R
@@ -196,5 +196,5 @@ RegLogServer <- R6::R6Class(
 
 #' @name RegLogServer
 #' @rdname RegLogServer
-#' @example examples/RegLogServer.R
+#' @example man/examples/RegLogServer.R
 NULL
diff --git a/R/RegLogServer_backend.R b/R/RegLogServer_backend.R
@@ -55,7 +55,7 @@ RegLogServer_backend <- function(
         } else {
 
           on.exit(blank_textInputs(inputs = c("login_user_id", "password_login"),
-                                    session = session))
+                                   session = session))
 
           shinyjs::runjs("$('.reglog_bttn').attr('disabled', true)")
 
@@ -99,7 +99,7 @@ RegLogServer_backend <- function(
         } else {
 
           on.exit(blank_textInputs(inputs = c("register_pass1", "register_pass2"),
-                                    session = session))
+                                   session = session))
 
           # check validity of inputs
 
@@ -121,10 +121,10 @@ RegLogServer_backend <- function(
             modals_check_n_show(
               private = private,
               modalname = if (!message_to_show$data$valid_id) "register_nonValidId"
-                     else if (!message_to_show$data$valid_email) "register_nonValidEmail"
-                     else if (!message_to_show$data$valid_pass) "register_nonValidPass"
-                     else if (!message_to_show$data$identical_pass) "register_notIdenticalPass"
-              )
+              else if (!message_to_show$data$valid_email) "register_nonValidEmail"
+              else if (!message_to_show$data$valid_pass) "register_nonValidPass"
+              else if (!message_to_show$data$identical_pass) "register_notIdenticalPass"
+            )
 
             # show message and save to logs if enabled
             self$message(message_to_show)
@@ -133,7 +133,7 @@ RegLogServer_backend <- function(
           } else {
 
             on.exit(blank_textInputs(inputs = c("register_user_ID", "register_email"),
-                                      session = session), add = T)
+                                     session = session), add = T)
 
             message_to_send <- RegLogConnectorMessage(
               type = "register",
@@ -170,7 +170,7 @@ RegLogServer_backend <- function(
             "credsEdit_front",
             success = FALSE,
             user_logged = FALSE,
-            change = "other"
+            change = "pass"
           )
 
           modals_check_n_show(private,
@@ -182,7 +182,7 @@ RegLogServer_backend <- function(
 
           # check if the inputs are filled
         } else if (!all(isTruthy(input$cred_edit_old_pass),
-                 isTruthy(input$cred_edit_new_pass1), isTruthy(input$cred_edit_new_pass2))) {
+                        isTruthy(input$cred_edit_new_pass1), isTruthy(input$cred_edit_new_pass2))) {
 
           message_to_show <- RegLogConnectorMessage(
             type = "credsEdit_front",
@@ -210,12 +210,12 @@ RegLogServer_backend <- function(
           )
 
           blank_textInputs(c("cred_edit_new_pass1", "cred_edit_new_pass2"),
-                            session = session)
+                           session = session)
 
           modals_check_n_show(
             private = private,
             modalname = if (!message_to_show$data$valid_pass) "credsEdit_nonValidPass"
-                   else if (!message_to_show$data$identical_pass) "credsEdit_notIdenticalPass"
+            else if (!message_to_show$data$identical_pass) "credsEdit_notIdenticalPass"
           )
           # if everything is OK - send the message
         } else {
@@ -226,8 +226,8 @@ RegLogServer_backend <- function(
           })
 
           blank_textInputs(c("cred_edit_new_pass1", "cred_edit_new_pass2", 
-                              "cred_edit_old_pass"), 
-                            session = session)
+                             "cred_edit_old_pass"), 
+                           session = session)
 
           message_to_send <- RegLogConnectorMessage(
             type = "credsEdit",
@@ -267,8 +267,8 @@ RegLogServer_backend <- function(
 
 
           # check if the inputs are filled
-        } else if (!isTruthy(input$cred_edit_old_pass) &&
-            !any(isTruthy(input$cred_edit_new_ID), isTruthy(input$cred_edit_new_mail))) {
+        } else if (!isTruthy(input$cred_edit_old_pass) ||
+                   (!isTruthy(input$cred_edit_new_ID) && !isTruthy(input$cred_edit_new_mail))) {
 
           message_to_show <- RegLogConnectorMessage(
             "credsEdit_front",
@@ -298,11 +298,11 @@ RegLogServer_backend <- function(
           modals_check_n_show(
             private = private,
             modalname = if (isFALSE(message_to_show$data$valid_id)) "credsEdit_nonValidId"
-                   else if (isFALSE(message_to_show$data$valid_email)) "credsEdit_nonValidEmail")
+            else if (isFALSE(message_to_show$data$valid_email)) "credsEdit_nonValidEmail")
 
           blank_textInputs(c("cred_edit_old_pass", 
-                              "cred_edit_new_ID", "cred_edit_new_mail"),
-                            session = session)
+                             "cred_edit_new_ID", "cred_edit_new_mail"),
+                           session = session)
 
         } else {
           # if everything is all right, send message to dbConnector
@@ -321,8 +321,8 @@ RegLogServer_backend <- function(
           )
 
           blank_textInputs(c("cred_edit_old_pass", 
-                              "cred_edit_new_ID", "cred_edit_new_mail"),
-                            session = session)
+                             "cred_edit_new_ID", "cred_edit_new_mail"),
+                           session = session)
 
           shinyjs::runjs("$('.reglog_bttn').attr('disabled', true)")
 
@@ -386,8 +386,8 @@ RegLogServer_backend <- function(
           modals_check_n_show(
             private = private, 
             modalname = if (!check_user_pass(input$reset_pass1)) "resetPass_nonValidPass"
-                   else if (input$reset_pass1 != input$reset_pass2) "resetPass_notIdenticalPass"
-            )
+            else if (input$reset_pass1 != input$reset_pass2) "resetPass_notIdenticalPass"
+          )
 
           message_to_show <- RegLogConnectorMessage(
             "resetPass_front",
@@ -399,7 +399,7 @@ RegLogServer_backend <- function(
           )
 
           blank_textInputs(c("reset_pass1", "reset_pass2"), 
-                            session = session)
+                           session = session)
 
         } else {
 
@@ -416,8 +416,8 @@ RegLogServer_backend <- function(
           )
 
           blank_textInputs(c("reset_user_ID", "reset_code", 
-                              "reset_pass1", "reset_pass2"), 
-                            session = session)
+                             "reset_pass1", "reset_pass2"), 
+                           session = session)
 
           shinyjs::runjs("$('.reglog_bttn').attr('disabled', true)")
         }