nassella/app
1
0
Fork 0
Code Issues 15 Pull Requests Packages Projects 1 Releases Wiki Activity

Migrations infra & working instance-control + commands

Browse Source
This commit is contained in:
Thomas Hintz
2026-05-23 20:53:44 -07:00
parent acdb4840aa
commit 348e1fa857
13 changed files with 262 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/Dockerfile
View File

@@ -29,7 +29,8 @@ WORKDIR /var/
RUN chicken-install srfi-1 srfi-13 srfi-18 srfi-19 srfi-158 srfi-194 \
sxml-transforms schematra \
uri-common http-client medea intarweb \
sql-null openssl postgresql crypto-tools
sql-null openssl postgresql crypto-tools \
hmac sha2 string-hexadecimal
WORKDIR /var
RUN mkdir nassella
@@ -55,6 +56,7 @@ COPY nassella-latest.tar nassella-latest.tar
COPY root-key root-key
COPY db-init.sql db-init.sql
COPY db-clean.sql db-clean.sql
COPY migrations/ migrations/
# ENTRYPOINT ["ls"]
# CMD ["/usr/local/lib/chicken/11"]

12
src/Makefile
View File

@@ -12,3 +12,15 @@ local:
localclean:
docker run -p 8080:8080 --net=host --rm nassella/b0.0.1 --clean
dev_db:
sudo docker compose up
dev_run:
make dockerall && make dockerpush && csi -D dev -s run.scm
dev_psql:
docker run -it --rm --network host -e PGPASSWORD="password" postgres psql -h 127.0.0.1 -U "nassella" -d "nassella"
dev_runhook:
curl -X POST -H "Content-Type: application/json" -d '{"path":"/","tag":"test4","request_id":"2","version":0}' https://nassella-instance-control.nassella.org/hooks/queue-restic-snapshot

8
src/db-init.sql
View File

@@ -40,7 +40,8 @@ create table user_selected_apps(
nextcloud_version varchar(100),
nassella_version varchar(100),
log_viewer_version varchar(100),
ghost_version varchar(100)
ghost_version varchar(100),
instance_control_version varchar(100)
);
create unique index user_selected_apps_user_id_instance_id_idx on user_selected_apps (user_id, instance_id);
@@ -88,3 +89,8 @@ create table user_terraform_state(
);
create unique index user_terraform_state_user_id_instance_id_idx on user_terraform_state (user_id, instance_id);
create table migrations(
id bigserial primary key,
migration_id integer not null unique,
);

105
src/db.scm
View File

@@ -33,6 +33,7 @@
(chicken string)
(chicken port)
(chicken io)
(chicken sort)
postgresql
sql-null
srfi-1
@@ -295,7 +296,9 @@ returning users.user_id;"
(nextcloud . "nextcloud_version")
(ghost . "ghost_version")
(nassella . "nassella_version")
(log-viewer . "log_viewer_version")))
(log-viewer . "log_viewer_version")
(instance-control . "instance_control_version")
))
(define *user-selected-apps-reverse-column-map*
(map (lambda (config)
@@ -493,7 +496,7 @@ returning users.user_id;"
(map-in-order (lambda (d) (string-append "d." (cdr d))) *deployments-column-map*)
", ")
", uac.root_domain, uac.config_enc, uac.instance_id, "
"usa.wg_easy_version, usa.nextcloud_version, usa.log_viewer_version, usa.ghost_version, usa.nassella_version "
"usa.wg_easy_version, usa.nextcloud_version, usa.log_viewer_version, usa.ghost_version, usa.nassella_version, usa.instance_control_version "
"from instances as i "
"join (select instance_id, max(id) as id from deployments group by instance_id) d2 "
"on d2.instance_id = i.instance_id "
@@ -515,6 +518,7 @@ returning users.user_id;"
(ghost_version . ghost)
(nassella_version . nassella)
(log_viewer_version . log-viewer)
(instance_control_version . instance-control)
,@*deployments-reverse-column-map*))))
`(,config . ,(if (sql-null? value)
#f
@@ -553,8 +557,92 @@ returning users.user_id;"
""
(user-decrypt-from-db (alist-ref 'state_backup_enc res) user-key user-iv user-id)))))))
;; (define (instance-config-for-export conn user-id instance-id)
;; (receive (user-key user-iv auth-user-id)
;; (get-decrypted-user-key-and-iv conn user-id)
;; (let ((res (row-alist
;; (query conn
;; "
;; select
;; instances.ssh_key_priv_enc,
;; instances.ssh_key_pub_enc,
;; instances.restic_password_enc,
;; user_service_configs.cloudflare_api_token_enc,
;; user_service_configs.cloudflare_account_id_enc,
;; user_service_configs.cloudflare_zone_id_enc,
;; user_service_configs.digitalocean_api_token_enc,
;; user_service_configs.digitalocean_region,
;; user_service_configs.digitalocean_size,
;; user_service_configs.backblaze_application_key_enc,
;; user_service_configs.backblaze_key_id_enc,
;; user_service_configs.backblaze_bucket_url_enc,
;; user_selected_apps.wg_easy_version,
;; user_selected_apps.nextcloud_version,
;; user_selected_apps.nassella_version,
;; user_selected_apps.log_viewer_version,
;; user_selected_apps.ghost_version,
;; user_app_configs.root_domain,
;; user_apps_configs.config_end
;; from instances
;; join user_service_configs on user_service_configs.user_id = instances.user_id and user_service_configs.instance_id = instances.instance_id
;; join user_selected_apps on user_selected_apps.user_id = instances.user_id and user_selected_apps.instance_id = instances.instance_id
;; join user_app_configs on user_apps_configs.user_id = instances.user_id and user_app_configs.instance_id = instances.instance_id
;; where instances.user_id=$1 and instance.instance_id=$2;"
;; user-id instance-id))))
;; `((state . ,(if (or (sql-null? (alist-ref 'config_enc res))
;; (sql-null? (alist-ref 'state_enc res)))
;; ""
;; (user-decrypt-from-db (alist-ref 'state_enc res) user-key user-iv user-id)))
;; (backup . ,(if (or (sql-null? (alist-ref 'config_enc res))
;; (sql-null? (alist-ref 'state_backup_enc res)))
;; ""
;; (user-decrypt-from-db (alist-ref 'state_backup_enc res) user-key user-iv user-id)))))))
;; TODO can/should this be removed? I don't remember why I put this here
(debug-log (current-error-port))
;; An a-list of migrations. The car is the migration_id in the migrations
;; table and the cdr is name of the file containing sql for the migration.
;; The file name is appended with "-up.sql" and "-down.sql", depending on if
;; an up or down migration should be run.
;;
;; After a migration has been run, it's migration id (the car in the alist) is
;; added to the database so the migration does not get re-run.
;;
;; To create a new migration:
;; add it to the end of this list with the car being one number higher than
;; the previous migration and the cdr being the filename containing sql statements
;; to run (not including a prefix of the ID or the suffic -up.sql or -down.sql).
;; add two sql files in the "migrations" folder, one ending in -up.sql and one ending
;; in -down.sql.
;; So to for a migration called "my-migration" with id "13 create two files in the
;; migrations directory: 13-my-migration-up.sql and 13-my-migration-down.sql
;;
;; The "up" file is called to run the migration and the "down" file is called to
;; "undo" the migration.
(define *migrations*
'((0 . "adding-instance-control-app")))
(define (run-pending-migrations conn)
(let* ((migration-ids (sort (map car *migrations*) <))
(migration-rows (query conn "select migration_id from migrations;"))
(applied-migration-ids (if (> (row-count migration-rows) 0)
(row-values migration-rows)
'())))
(for-each
(lambda (id)
(when (not (member id applied-migration-ids))
(log-to (debug-log) "running migration: ~A" id)
(for-each
(lambda (statement)
(query conn (conc statement ";")))
(string-split (with-input-from-file
(conc "migrations/" id "-" (alist-ref id *migrations*) "-up.sql")
read-string)
";"))
(query conn "insert into migrations(migration_id) values ($1);" id)))
migration-ids)))
(define (db-init)
(with-db/transaction
(lambda (db)
@@ -571,7 +659,18 @@ returning users.user_id;"
(log-to (debug-log) "table creation finished")
(log-to (debug-log) "creating test user")
(create-user db "me@example.com" "username")
(log-to (debug-log) "test user creation finished"))))))
(log-to (debug-log) "test user creation finished")))
;; originally there was no migrations table, so first add it if it doesn't exist
(if (value-at (query db "SELECT EXISTS (SELECT FROM pg_tables WHERE schemaname = 'public' AND tablename = 'migrations');"))
#t
(begin
(log-to (debug-log) "migrations table not found in db. Creating...")
(query db "create table migrations(
id bigserial primary key,
migration_id integer not null unique
);")
(log-to (debug-log) "migrations table creation finished")))
(run-pending-migrations db))))
(define (db-clean)
(with-db/transaction

79
src/nassella.scm
View File

@@ -32,7 +32,10 @@
nassella-db
sql-null
openssl
spiffy)
spiffy
hmac
sha256-primitive
string-hexadecimal)
(define app (schematra/make-app))
@@ -902,6 +905,23 @@ chmod -R 777 /opt/keys")))
(lambda ()
(delete-file password-path)))))
;; TODO is this actually needed?
(single-headers (cons 'X-Nassella-Signature (single-headers)))
(header-parsers (cons `(X-Nassella-Signature . ,(single identity)) (header-parsers)))
(define (send-instance-control-command domain subdomain command secret-key data)
(let ((json (json->string data)))
(with-input-from-request
(make-request method: 'POST
uri: (uri-reference (conc "https://" subdomain "." domain "/hooks/" command))
headers: (headers `((content-type application/json)
(X-Nassella-Signature
#(,(string->hex ((hmac secret-key (sha256-primitive)) json))
())))))
(lambda ()
(write-json data))
read-json)))
(with-schematra-app app
(lambda ()
@@ -1098,7 +1118,8 @@ chmod -R 777 /opt/keys")))
`((wg-easy . ,(or (and (alist-ref 'wg-easy (current-params)) "15.1.0") (sql-null)))
(nextcloud . ,(or (and (alist-ref 'nextcloud (current-params)) "31.0.8") (sql-null)))
(ghost . ,(or (and (alist-ref 'ghost (current-params)) "6.10.0") (sql-null)))
(nassella . ,(or (and (alist-ref 'nassella (current-params)) "b0.0.1") (sql-null)))))
(nassella . ,(or (and (alist-ref 'nassella (current-params)) "b0.0.1") (sql-null)))
(instance-control . "b0.0.1")))
(update-root-domain db
(session-user-id)
instance-id
@@ -1238,7 +1259,8 @@ chmod -R 777 /opt/keys")))
(smtp-auth-user . ,(alist-ref 'smtp-auth-user (current-params)))
(smtp-auth-password . ,(alist-ref 'smtp-auth-password (current-params)))
(smtp-from . ,(alist-ref 'smtp-from (current-params)))))
(instance-control . ((webhooks-secret . ,(or (alist-ref 'webhooks-secret
(instance-control . ((subdomain . "nassella-instance-control")
(webhooks-secret . ,(or (alist-ref 'webhooks-secret
(alist-ref 'instance-control config eq? '()))
(generate-jwt-secret))))))))))
(redirect (conc "/config/wizard/machine/" instance-id))))
@@ -1449,7 +1471,7 @@ chmod -R 777 /opt/keys")))
("cluster_name" . "nassella")
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
;; (source <(curl -sSfL https://stable.release.flatcar-linux.net/amd64-usr/current/version.txt); echo "${FLATCAR_VERSION_ID}")
("flatcar_stable_version" . "4593.2.0")))
("flatcar_stable_version" . "4593.2.1")))
;; remove the newline that generating the ssh key adds
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]"))))
(let* ((instance-id (alist-ref "id" (current-params) equal?))
@@ -1580,11 +1602,14 @@ chmod -R 777 /opt/keys")))
,(alist-ref 'subdomain (alist-ref app config))
"." ,root-domain)))
#f)))
;; TODO update links
'((wg-easy . "https://wg-easy.github.io/wg-easy/Pre-release/")
(nextcloud . "https://nextcloud.com/support/")
(ghost . "https://nextcloud.com/support/")
(nassella . "https://nextcloud.com/support/")
(log-viewer . "https://nextcloud.com/support/")))))
(log-viewer . "https://nextcloud.com/support/")
;; (instance-control . "https://nextcloud.com/support/")
))))
(h3 "Actions")
(ul (li (a (@ (href "/config/wizard/services/"
,(alist-ref 'instance-id instance)))
@@ -1707,7 +1732,7 @@ chmod -R 777 /opt/keys")))
("cluster_name" . "nassella")
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
;; (source <(curl -sSfL https://stable.release.flatcar-linux.net/amd64-usr/current/version.txt); echo "${FLATCAR_VERSION_ID}")
("flatcar_stable_version" . "4593.2.0")))
("flatcar_stable_version" . "4593.2.1")))
;; remove the newline that generating the ssh key adds
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]")))
;; TODO need a new table to track destroying?
@@ -1826,10 +1851,10 @@ chmod -R 777 /opt/keys")))
(Main-Container
(VStack
(h1 "Backups")
(a (@ (href "/")) "Create Snapshot") ;; TODO
(a (@ (href ,(conc "/backups/" instance-id "/create"))) "Create Snapshot")
(table
(thead
(tr (th "Time") (th "Data Added (MiB)") (th "Total Size (MiB)") (th "Tag") (th "*")))
(tr (th "Time") (th "Total Size (MiB)") (th "Tag") (th "*")))
(tbody
,@(map (lambda (snapshot)
`(tr
@@ -1837,7 +1862,7 @@ chmod -R 777 /opt/keys")))
(td ,(roundx
(/ (or (alist-ref 'total_bytes_processed (alist-ref 'summary snapshot)) 0) bytes-in-mib)))
(td ,(or (alist-ref 'tags snapshot) ""))
(td (a (@ (href ,(conc "/backups/" instance-id "/"
(td (a (@ (href ,(conc "/backups/" instance-id "/restore/"
(alist-ref 'short_id snapshot))))
"Restore"))))
(sort
@@ -1846,7 +1871,7 @@ chmod -R 777 /opt/keys")))
(restic-date-string->date (alist-ref 'time b)))))))))))))
(get/widgets
("/backups/:instance_id/:restic_id")
("/backups/:instance_id/restore/:restic_id")
(let* ((instance-id (alist-ref "instance_id" (current-params) equal?))
(restic-id (alist-ref "restic_id" (current-params) equal?))
(snapshot-info (find (lambda (snapshot)
@@ -1889,6 +1914,40 @@ chmod -R 777 /opt/keys")))
(VStack
(Form-Nav (@ (back-to ,(conc "/backups/" instance-id)) (submit-button "Restore"))))))))))
(get/widgets
("/backups/:instance_id/create")
(let* ((instance-id (alist-ref "instance_id" (current-params) equal?))
(root-domain (alist-ref 'root-domain
(with-db/transaction
(lambda (db)
(get-user-app-config db (session-user-id) instance-id))))))
`(App
(Main-Container
(VStack
(h1 "Create Snapshot")
(h2 "Root Domain")
,root-domain
(form
(@ (action ,(conc "/backups/" instance-id "/create-submit")) (method POST))
(Fieldset (@ (title "Snapshot Properties"))
(Field (@ (name "tag") (label ("Tag")))))
(VStack
(Form-Nav (@ (back-to ,(conc "/backups/" instance-id)) (submit-button "Create"))))))))))
(post "/backups/:instance_id/create-submit"
(let ((instance-id (alist-ref "instance_id" (current-params) equal?))
(app-config (with-db/transaction
(lambda (db)
(get-user-app-config db (session-user-id) instance-id)))))
;; TODO make requests to instance control
;; get the root domain and subdomain for instance control
;; then call subdomain.rootdomain/hooks/queue-restic-snapshot
;; content-type application/json
;; data: 'path "/" 'tag tag 'request_id (generate-one?) 'version 0
;; then run through hmac ((hmac "instance-control-secret-key" sha256-primitive) data)
;; then make a new page to redirect the user to that polls for status page using the request id
(redirect (conc "/config/wizard/review/" instance-id))))
(schematra-install)
))