a veure el deploy

Dockerfile

@@ -43,11 +43,11 @@ RUN set -eux; \
         rm -rf /var/lib/apt/lists/*;
         
 # Install R packages
-RUN install2.r --error -s --deps TRUE htmltools tidyverse zeallot rlang glue this.path DBI pool RSQLite remotes promises assertthat log here
+RUN install2.r --error -s --deps TRUE htmltools tibble dplyr purrr rlang glue this.path DBI pool RSQLite remotes promises assertthat log here zeallot dbplyr stringr tidyverse
 RUN Rscript -e "install.packages('b64', repos = c('https://extendr.r-universe.dev', getOption('repos')))" 
 RUN Rscript -e "install.packages('uwu', repos = c('https://josiahparry.r-universe.dev', getOption('repos')))" 
-RUN installGithub.r devOpifex/ambiorix devOpifex/scilis devOpifex/signaculum jrosell/ambhtmx
-
+RUN --mount=type=secret,id=GITHUB_PAT GITHUB_PAT=$(cat /run/secrets/GITHUB_PAT) \
+    installGithub.r devOpifex/ambiorix devOpifex/scilis devOpifex/signaculum jrosell/ambhtmx
 
 # Prepare a user
 RUN useradd --create-home --shell /bin/bash user

Makefile

@@ -14,7 +14,11 @@ clean:
 		&& echo "Done"
 
 build:
-	docker build -f Dockerfile  --no-cache --progress=plain -t ambhtmx-image . 2>&1 | tee build.log
+	docker build -f Dockerfile --no-cache --progress=plain -t ambhtmx-image . 2>&1 | tee build.log
 
 run:
-	docker run --env-file=.Renviron -p 7860:7860 --name ambhtmx-container --rm ambhtmx-image
+	docker run --env-file=.Renviron -p 7860:7860 --name ambhtmx-container --rm ambhtmx-image
+
+secrets:
+	docker build --secret id=GITHUB_PAT,src=/run/secrets/GITHUB_PAT -f Dockerfile -t ambhtmx-image .  \
+		&& docker run --env-file=.Renviron -p 7860:7860 --name ambhtmx-container --rm ambhtmx-image 

app.R

@@ -7,8 +7,7 @@ if(!"rlang" %in% installed.packages()){
 }
 
 rlang::check_installed("remotes")
-remotes::install_github("jrosell/ambhtmx", force = TRUE)
-rlang::check_installed("ambiorix", action = \(pkg, ... ) remotes::install_github("devOpifex/ambiorix"))
+rlang::check_installed("ambhtmx", action = \(pkg, ... ) remotes::install_github("devOpifex/ambhtmx"))
 rlang::check_installed("ambiorix", action = \(pkg, ... ) remotes::install_github("devOpifex/ambiorix"))
 rlang::check_installed("scilis", action = \(pkg, ... ) remotes::install_github("devOpifex/scilis"))
 rlang::check_installed("signaculum", action = \(pkg, ... ) remotes::install_github("devOpifex/signaculum"))
@@ -22,24 +21,12 @@ options(
   'ambiorix.host'=Sys.getenv('AMBHTMX_HOST'),
   'ambiorix.port'=Sys.getenv('AMBHTMX_PORT')
 )
-
+# remotes::install_github("jrosell/ambhtmx", force = TRUE)
 library(ambhtmx)
-# devtools::load_all()
-library(ambiorix)
-library(tidyverse)
 library(zeallot)
-library(glue)
-library(htmltools)
-library(signaculum)
 
 page_title <- "Password protected CRUD (Create, Read, Update, and Delete) example with ambhtmx"
 
-live_path <- tryCatch(
-  {this.path::this.path()},
-  error = function(e) return("")
-)
-print(live_path)
-
 render_index <- \() {
   main <- NULL
   tryCatch({
@@ -61,7 +48,7 @@ render_index <- \() {
             )
           })
       }
-      main <- withTags(div(id = "page", style = "margin: 50px",
+      main <- div(id = "page", style = "margin: 50px",
           div(style ="float:right", id = "logout", button("Logout", onclick = "void(location.href='/logout')")),
           h1(page_title),
           div(id = "main", style = "margin-top: 20px", tagList(
@@ -75,13 +62,40 @@ render_index <- \() {
                   `hx-swap` = "innerHTML"
                 )
           ))
-      ))
+      )
     },
     error = \(e) print(e)
   )
   return(main)
 }
 
+render_new <- \(req, res) {
+  errors <- process_error_get(req, res)
+  render_tags(tagList(
+    h2("New item"),
+    div(label("Name", p(input(name = "name")))),
+    div(label("Content", p(textarea(name = "content")))),
+    a(
+      "Go back",
+      href = "/",
+      style = "margin-right:20px",
+      `hx-confirm` = "Are you sure you want to go back?",
+      `hx-get` = "/items",
+      `hx-target` = "#page",
+      `hx-swap` = "outerHTML",
+      `hx-encoding` = "multipart/form-data"
+    ),      
+    button(
+      "Create",
+      style = "margin-top:20px",
+      `hx-post` = "/items",
+      `hx-target` = "#page",
+      `hx-swap` = "outerHTML",
+      `hx-include` = "[name='name'], [name='content']",
+    ),
+    errors
+  ))
+}
 
 render_row <- \(item) {
   tags$div(    
@@ -103,270 +117,231 @@ c(app, context, items) %<-%
       name = character(1),
       content = character(1)
     ),
-    # live = live_path,
     render_index = render_index,
     render_row = render_row
   )
 
 #' Authentication feature with secret cookies and .Renviron variables
 app$get("/login", \(req, res) {
-  process_login_get(
-    req,
-    res
-  )
+  process_login_get(req, res)
 })
-app$post("/login", \(req, res) {   
-  print(req$HTTP_HOST)
-  process_login_post(
-    req,
-    res,
-    user = Sys.getenv("AMBHTMX_USER"),
-    password = Sys.getenv("AMBHTMX_PASSWORD"),
-  )
+app$post("/login", \(req, res) {      
+  process_login_post(req, res)
 })
 app$get("/logout", \(req, res) {
-  process_logout_get(
-    req,
-    res
-  )
+  process_logout_get(req, res)
 })
 app$use(\(req, res){
-  process_loggedin_middleware(
-    req,
-    res,
-    user = Sys.getenv("AMBHTMX_USER")
-  )
+  process_loggedin_middleware(req, res)
 })
 
 #' Some CRUD operations examples
 cat("\nBe sure is initially empty:\n")
-items$read_rows(context = context) |> print()
+walk(items$read_rows()$id, \(x) items$delete_row(id = x))
+items$read_rows() |> print()
 
-# cat("\nNot, it should be empty:\n")
-# walk(items$read_rows()$id, \(x) items$delete_row(id = x))
-# items$read_rows() |> print()
+cat("\nAdd some items:\n")
+tibble(name = "Elis elis", content = "Putxinelis.",) |> 
+  items$add_row() -> first_id
+tibble(name = "Que bombolles", content = "T\'empatolles.") |> 
+  items$add_row() -> some_id
+tibble(name = "Holi", content = "Guapi.") |> 
+  items$add_row() -> last_id
+items$read_rows() |> print()
 
-# cat("\nAdd some items:\n")
-# tibble(name = "Elis elis", content = "Putxinelis.",) |> 
-#   items$add_row() -> first_id
-# tibble(name = "Que bombolles", content = "T\'empatolles.") |> 
-#   items$add_row() -> some_id
-# tibble(name = "Holi", content = "Guapi.") |> 
-#   items$add_row() -> last_id
-# items$read_rows() |> print()
+cat("\nDelete last item:\n")
+items$delete_row(id = last_id)
+items$read_rows() |> print()
 
-# cat(glue("\nDelete last item id={last_id}:\n"))
-# items$delete_row(context = context, id = last_id)
-# cat(glue("\nDelete last item id={last_id}:\n"))
-# items$read_rows() |> print()
+cat("\nUpdate first items:\n")
+tibble(name = "First", content = "Hello in <span style='color:red'>red</span>.") |>
+  items$update_row(id = first_id)
+items$read_rows() |> print()
 
-# cat("\nUpdate first items:\n")
-# tibble(name = "First", content = "Hello in <span style='color:red'>red</span>.") |>
-#   items$update_row(id = first_id)
-# items$read_rows() |> print()
+cat("\nRender the first item:\n")
+items$read_row(id = first_id) |> 
+  items$read_row() |> 
+  as.character() |> 
+  cat()
 
-# cat("\nRender the first item:\n")
-# items$read_row(id = first_id) |> 
-#   items$read_row() |> 
-#   as.character() |> 
-#   cat()
+cat("\nAdd an item with id 1:\n")
+tibble(id = "1", name = "Quines postres", content = "Tant bones.") |>
+  items$add_row()
+items$read_rows() |> print()
 
-# cat("\nAdd an item with id 1:\n")
-# tibble(id = "1", name = "Quines postres", content = "Tant bones.") |>
-#   items$add_row()
-# items$read_rows() |> print()
 
+#' The main page
+app$get("/", \(req, res){  
+  if (!req$loggedin) {    
+    return(res$redirect("/login", status = 302L))
+  }
+  html <- ""  
+  tryCatch({
+      html <- render_page(
+          page_title = page_title,
+          main = items$render_index()
+      )
+    },
+    error = \(e) print(e)
+  )
+  res$send(html)
+})
 
-# #' The main page
-# app$get("/", \(req, res){
-#   # r <- process_loggedin_redirect(req, res)
-#   # if(!is.null(r)) return(r)
-#   if (!req$loggedin) {    
-#     return(res$redirect("/login", status = 302L))
-#   }
-#   html <- ""  
-#   tryCatch({
-#       html <- render_page(
-#           page_title = page_title,
-#           main = items$render_index()
-#       )
-#     },
-#     error = \(e) print(e)
-#   )
-#   res$send(html)
-# })
+#' Read the index of the items
+app$get("/items", \(req, res){  
+  if (!req$loggedin) {    
+    return(res$redirect("/login", status = 302L))
+  }
+  res$send(items$render_index())
+})
 
-# #' Read the index of the items
-# app$get("/items", \(req, res){  
-#   if (!req$loggedin) {    
-#     return(res$redirect("/login", status = 302L))
-#   }
-#   res$send(items$render_index())
-# })
+#' New item form
+app$get("/items/new", \(req, res){
+  if (!req$loggedin) {    
+    return(res$redirect("/login", status = 302L))
+  }
+  tryCatch({
+      html <- render_new(req, res)
+    },
+    error = \(e) print(e)
+  )  
+  res$send(html)
+})
 
-# #' New item form
-# app$get("/items/new", \(req, res){
-#   if (!req$loggedin) {    
-#     return(res$redirect("/login", status = 302L))
-#   }
-#   errors <- process_error_get(req, res)
-#   html <- render_tags(withTags(tagList(
-#       h2("New item"),
-#       div(label("Name", p(input(name = "name")))),
-#       div(label("Content", p(textarea(name = "content")))),
-#       a(
-#         "Go back",
-#         href = "/",
-#         style = "margin-right:20px",
-#         `hx-confirm` = "Are you sure you want to go back?",
-#         `hx-get` = "/items",
-#         `hx-target` = "#page",
-#         `hx-swap` = "outerHTML",
-#         `hx-encoding` = "multipart/form-data"
-#       ),      
-#       button(
-#         "Create",
-#         style = "margin-top:20px",
-#         `hx-post` = "/items",
-#         `hx-target` = "#page",
-#         `hx-swap` = "outerHTML",
-#         `hx-include` = "[name='name'], [name='content']",
-#       ),
-#       errors
-#   )))
-#   res$send(html)
-# })
 
+#' Show an existing item
+app$get("/items/:id", \(req, res){
+  if (!req$loggedin) {    
+    return(res$redirect("/login", status = 302L))
+  }
+  item_id <- req$params$id %||% ""
+  item <- items$read_row(id = item_id)   
+  html <- render_tags(tagList(
+    h2("Show item details"),
+    items$render_row(item),
+    a(
+      "Go back",
+      href = "/",
+      style = "margin-right:20px",
+      `hx-get` = "/items",
+      `hx-target` = "#page",
+      `hx-swap` = "outerHTML",
+    ),
+    a(
+      "Delete",
+      href = "/",
+      style = "color: red; margin-right:20px",
+      `hx-confirm` = "Are you sure you want to delete the item?",
+      `hx-delete` = glue("/items/{item$id}"),
+      `hx-target` = "#page",
+      `hx-swap` = "outerHTML",
+      `hx-encoding` = "multipart/form-data"
+    ),
+    button(
+      "Edit",
+      style = "margin-top:20px",
+      `hx-get` = glue("/items/{item_id}/edit"),
+      `hx-target` = "#main",
+      `hx-swap` = "innerHTML"
+    )
+  ))
+  res$send(html)
+})
 
-# #' Show an existing item
-# app$get("/items/:id", \(req, res){
-#   if (!req$loggedin) {    
-#     return(res$redirect("/login", status = 302L))
-#   }
-#   item_id <- req$params$id %||% ""
-#   item <- items$read_row(id = item_id)   
-#   html <- render_tags(withTags(tagList(
-#     h2("Show item details"),
-#     items$render_row(item),
-#     a(
-#       "Go back",
-#       href = "/",
-#       style = "margin-right:20px",
-#       `hx-get` = "/items",
-#       `hx-target` = "#page",
-#       `hx-swap` = "outerHTML",
-#     ),
-#     a(
-#       "Delete",
-#       href = "/",
-#       style = "color: red; margin-right:20px",
-#       `hx-confirm` = "Are you sure you want to delete the item?",
-#       `hx-delete` = glue("/items/{item$id}"),
-#       `hx-target` = "#page",
-#       `hx-swap` = "outerHTML",
-#       `hx-encoding` = "multipart/form-data"
-#     ),
-#     button(
-#       "Edit",
-#       style = "margin-top:20px",
-#       `hx-get` = glue("/items/{item_id}/edit"),
-#       `hx-target` = "#main",
-#       `hx-swap` = "innerHTML"
-#     )
-#   )))
-#   res$send(html)
-# })
+#' Edit item form
+app$get("/items/:id/edit", \(req, res){
+  if (!req$loggedin) {    
+    return(res$redirect("/login", status = 302L))
+  }
+  item_id <- req$params$id %||% ""
+  item <- items$read_row(id = item_id)
+  html <- render_tags(tagList(
+    h2("Edit item"),
+    input(type = "hidden", name = "id", value = item$id),
+    div(label("Name", p(input(name = "name", value = item$name)))),
+    div(HTML(glue('<textarea rows=5 name="content">{item$content}</textarea>'))),
+    a(
+      "Go back",
+      href = "/",
+      style = "margin-right:20px",
+      `hx-confirm` = "Are you sure you want to go back?",
+      `hx-get` = "/items",
+      `hx-target` = "#page",
+      `hx-swap` = "outerHTML",
+      `hx-encoding` = "multipart/form-data"
+    ),
+    button(
+      "Update",
+      style = "margin-top:20px",
+      `hx-put` = glue("/items/{item$id}"),
+      `hx-target` = "#page",
+      `hx-swap` = "outerHTML",
+      `hx-include` = "[name='name'], [name='content']",
+    )
+  ))
+  res$send(html)
+})
 
-# #' Edit item form
-# app$get("/items/:id/edit", \(req, res){
-#   if (!req$loggedin) {    
-#     return(res$redirect("/login", status = 302L))
-#   }
-#   item_id <- req$params$id %||% ""
-#   item <- items$read_row(id = item_id)
-#   html <- render_tags(withTags(tagList(
-#     h2("Edit item"),
-#     input(type = "hidden", name = "id", value = item$id),
-#     div(label("Name", p(input(name = "name", value = item$name)))),
-#     div(HTML(glue('<textarea rows=5 name="content">{item$content}</textarea>'))),
-#     a(
-#       "Go back",
-#       href = "/",
-#       style = "margin-right:20px",
-#       `hx-confirm` = "Are you sure you want to go back?",
-#       `hx-get` = "/items",
-#       `hx-target` = "#page",
-#       `hx-swap` = "outerHTML",
-#       `hx-encoding` = "multipart/form-data"
-#     ),
-#     button(
-#       "Update",
-#       style = "margin-top:20px",
-#       `hx-put` = glue("/items/{item$id}"),
-#       `hx-target` = "#page",
-#       `hx-swap` = "outerHTML",
-#       `hx-include` = "[name='name'], [name='content']",
-#     )
-#   )))
-#   res$send(html)
-# })
 
-# #' Create a new item
-# app$post("/items", \(req, res){
-#   if (!req$loggedin) {    
-#     return(res$redirect("/login", status = 302L))
-#   }
-#   params <- parse_multipart(req)  
-#   if (is.null(params[["name"]])) {    
-#     return(process_error_post(
-#       req,
-#       res,
-#       errors = "Name is required",
-#       error_url = "/items/new"
-#     ))
-#   }
-#   if (is.null(params[["content"]])) {
-#     params[["content"]] = ""
-#   }
-#   tryCatch({
-#       params |> 
-#         as_tibble() |>
-#         items$add_row()
-#     }, 
-#     error = \(e) print(e)
-#   )    
-#   res$send(items$render_index())
-# })
+#' Create a new item
+app$post("/items", \(req, res){
+  if (!req$loggedin) {    
+    return(res$redirect("/login", status = 302L))
+  }
+  params <- parse_multipart(req)  
+  if (is.null(params[["name"]])) {    
+    error_message <- "Name is required."
+    res$cookie(
+      name = "errors",
+      value = error_message
+    )
+    res$header("HX-Retarget", "#main")
+    res$header("HX-Reswap", "innerHTML")
+    print("Retarget amb error")
+    return(res$send(render_new(req, res)))
+  }
+  if (is.null(params[["content"]])) {
+    params[["content"]] = ""
+  }
+  tryCatch({
+      params |> 
+        as_tibble() |>
+        items$add_row()
+    }, 
+    error = \(e) print(e)
+  )    
+  res$send(items$render_index())
+})
 
-# #' Update an existing item
-# app$put("/items/:id", \(req, res){
-#   if (!req$loggedin) {    
-#     return(res$redirect("/login", status = 302L))
-#   }
-#   item_id <- req$params$id %||% ""  
-#   params <- parse_multipart(req) |> 
-#     as_tibble() |> 
-#     mutate(id = item_id)
-#   item <- items$read_row(id = item_id)  
-#   tryCatch({
-#       item |>
-#         dplyr::rows_upsert(params, by = "id") |>
-#         items$update_row()    
-#     }, 
-#     error = \(e) print(e)
-#   )
-#   res$send(items$render_index())
-# })
+#' Update an existing item
+app$put("/items/:id", \(req, res){
+  if (!req$loggedin) {    
+    return(res$redirect("/login", status = 302L))
+  }
+  item_id <- req$params$id %||% ""  
+  params <- parse_multipart(req) |> 
+    as_tibble() |> 
+    mutate(id = item_id)
+  item <- items$read_row(id = item_id)  
+  tryCatch({
+      item |>
+        dplyr::rows_upsert(params, by = "id") |>
+        items$update_row()    
+    }, 
+    error = \(e) print(e)
+  )
+  res$send(items$render_index())
+})
 
-# #' Delete an existing item
-# app$delete("/items/:id", \(req, res){
-#   if (!req$loggedin) {    
-#     return(res$redirect("/login", status = 302L))
-#   }
-#   item_id <- req$params$id %||% ""  
-#   items$delete_row(id = item_id)
-#   res$send(items$render_index())
-# })
+#' Delete an existing item
+app$delete("/items/:id", \(req, res){
+  if (!req$loggedin) {    
+    return(res$redirect("/login", status = 302L))
+  }
+  item_id <- req$params$id %||% ""  
+  items$delete_row(id = item_id)
+  res$send(items$render_index())
+})
 
-# #' Start the app with all the previous defined routes
-# app$start(open = FALSE)
+#' Start the app with all the previous defined routes
+app$start()