Postgres db integration.
parent
8595014fde
commit
fb9c3f8daf
@ -0,0 +1,15 @@
|
||||
services:
|
||||
db:
|
||||
image: postgres
|
||||
restart: always
|
||||
environment:
|
||||
POSTGRES_USER: nassella
|
||||
POSTGRES_PASSWORD: password
|
||||
POSTGRES_DB: nassella
|
||||
healthcheck:
|
||||
test: ["CMD-SHELL", "pg_isready", "-U", "nassella"]
|
||||
interval: 1s
|
||||
timeout: 5s
|
||||
retries: 10
|
||||
ports:
|
||||
- "5432:5432"
|
||||
@ -0,0 +1,41 @@
|
||||
create table users(
|
||||
user_id bigserial primary key,
|
||||
auth_user_id int unique not null,
|
||||
email varchar(255) not null,
|
||||
username varchar(255) not null unique,
|
||||
key_key varchar(255),
|
||||
key_iv varchar(255));
|
||||
create unique index users_auth_user_id_idx on users (auth_user_id);
|
||||
|
||||
create table user_service_configs(
|
||||
id bigserial primary key,
|
||||
user_id integer unique not null references users on delete cascade,
|
||||
cloudflare_api_token_enc varchar(255),
|
||||
cloudflare_account_id_enc varchar(255),
|
||||
cloudflare_zone_id_enc varchar(255),
|
||||
digitalocean_api_token_enc varchar(255),
|
||||
digitalocean_region varchar(255),
|
||||
digitalocean_size varchar(255),
|
||||
backblaze_application_key_enc varchar(255),
|
||||
backblaze_key_id_enc varchar(255),
|
||||
backblaze_bucket_url_enc varchar(255)
|
||||
);
|
||||
create unique index user_service_configs_user_id_idx on user_service_configs (user_id);
|
||||
|
||||
create table user_selected_apps(
|
||||
id bigserial primary key,
|
||||
user_id integer unique not null references users on delete cascade,
|
||||
wg_easy_version varchar(100),
|
||||
nextcloud_version varchar(100),
|
||||
log_viewer_version varchar(100)
|
||||
);
|
||||
create unique index user_selected_apps_user_id_idx on user_selected_apps (user_id);
|
||||
|
||||
create table user_app_configs(
|
||||
id bigserial primary key,
|
||||
user_id integer unique not null references users on delete cascade,
|
||||
root_domain varchar(100),
|
||||
config_enc text
|
||||
);
|
||||
|
||||
create unique index user_app_configs_user_id_idx on user_app_configs (user_id);
|
||||
@ -0,0 +1,327 @@
|
||||
(module nassella-db
|
||||
(;; parameters
|
||||
connection-spec
|
||||
|
||||
;;functions
|
||||
with-db with-db/transaction
|
||||
|
||||
create-user
|
||||
update-user-service-config get-user-service-config
|
||||
update-user-selected-apps get-user-selected-apps
|
||||
update-user-app-config get-user-app-config
|
||||
update-root-domain
|
||||
)
|
||||
|
||||
(import scheme
|
||||
(chicken base)
|
||||
(chicken blob)
|
||||
(chicken file)
|
||||
(chicken string)
|
||||
(chicken port)
|
||||
postgresql
|
||||
sql-null
|
||||
srfi-1
|
||||
srfi-13
|
||||
(openssl cipher)
|
||||
(openssl random)
|
||||
crypto-tools)
|
||||
|
||||
(define connection-spec (make-parameter '((dbname . "nassella") (user . "nassella") (password . "password") (host . "127.0.0.1"))))
|
||||
(define db-connection (make-parameter #f))
|
||||
|
||||
(define (with-db proc)
|
||||
(if (db-connection)
|
||||
(begin (db-connection)
|
||||
(proc (db-connection)))
|
||||
(let ((conn #f))
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
(set! conn (connect (connection-spec))))
|
||||
(lambda () (proc conn))
|
||||
(lambda ()
|
||||
(when (and (connection? conn) (connected? conn))
|
||||
(disconnect conn)))))))
|
||||
|
||||
(define (with-db/transaction proc)
|
||||
(with-db
|
||||
(lambda (conn)
|
||||
(with-transaction conn
|
||||
(lambda () (proc conn))))))
|
||||
|
||||
;; (with-db (lambda (db) (row-values (query db "select * from users;"))))
|
||||
|
||||
(define aes-256-gcm (cipher-by-name "aes-256-gcm"))
|
||||
(define tag-length 16)
|
||||
|
||||
(define (generate-param accessor)
|
||||
(random-bytes (accessor aes-256-gcm)))
|
||||
|
||||
(define (generate-key) (generate-param cipher-key-length))
|
||||
(define (generate-iv) (generate-param cipher-iv-length))
|
||||
|
||||
(define (encrypt message key iv #!optional auth-data)
|
||||
(string-encrypt-and-digest aes-256-gcm message key iv
|
||||
tag-length: tag-length
|
||||
auth-data: auth-data))
|
||||
|
||||
(define (decrypt message tag key iv #!optional auth-data)
|
||||
(string-decrypt-and-verify aes-256-gcm message tag key iv
|
||||
auth-data: auth-data))
|
||||
|
||||
(define *root-key-file* "root-key")
|
||||
(define (generate-root-key) (generate-key))
|
||||
(define (save-root-key)
|
||||
(with-output-to-file *root-key-file* (lambda () (write (blob->hexstring/uppercase (generate-root-key))))))
|
||||
(define (load-root-key)
|
||||
(hexstring->blob (with-input-from-file *root-key-file* read)))
|
||||
|
||||
(define *root-key-iv* (hexstring->blob "1EBBCF6B50C68593C559EF93"))
|
||||
(define (ensure-root-key)
|
||||
(when (not (file-exists? *root-key-file*))
|
||||
(save-root-key))
|
||||
(load-root-key))
|
||||
(define *root-key-key* (ensure-root-key))
|
||||
|
||||
(define (get-user-key-and-iv conn user-id)
|
||||
(row-alist (query conn "select auth_user_id, key_key, key_iv from users where user_id=$1;" user-id)))
|
||||
|
||||
(define (get-decrypted-user-key-and-iv conn user-id)
|
||||
(let* ((auth-user-id-and-user-key-and-iv (get-user-key-and-iv conn user-id))
|
||||
(raw-user-key-and-tag (alist-ref 'key_key auth-user-id-and-user-key-and-iv))
|
||||
(raw-user-key (hexstring->blob (string-drop-right raw-user-key-and-tag (* tag-length 2))))
|
||||
(raw-user-tag (hexstring->blob (string-take-right raw-user-key-and-tag (* tag-length 2))))
|
||||
(user-key (decrypt (blob->string raw-user-key) (blob->string raw-user-tag) *root-key-key* *root-key-iv*
|
||||
(string->blob (number->string (alist-ref 'auth_user_id auth-user-id-and-user-key-and-iv)))))
|
||||
(user-iv (alist-ref 'key_iv auth-user-id-and-user-key-and-iv))
|
||||
(auth-user-id (alist-ref 'auth_user_id auth-user-id-and-user-key-and-iv)))
|
||||
(values (hexstring->blob user-key) (hexstring->blob user-iv) auth-user-id)))
|
||||
|
||||
(define (user-encrypt message user-key user-iv user-id)
|
||||
(encrypt message user-key user-iv (string->blob (number->string user-id))))
|
||||
|
||||
(define (user-encrypt-for-db message user-key user-iv user-id)
|
||||
(receive (message tag)
|
||||
(user-encrypt message user-key user-iv user-id)
|
||||
(string-append (blob->hexstring/uppercase (string->blob message))
|
||||
(blob->hexstring/uppercase (string->blob tag)))))
|
||||
|
||||
(define (user-decrypt message tag user-key user-iv user-id)
|
||||
(decrypt message tag user-key user-iv (string->blob (number->string user-id))))
|
||||
|
||||
(define (user-decrypt-from-db message-and-tag user-key user-iv user-id)
|
||||
(let ((raw-message (hexstring->blob (string-drop-right message-and-tag (* tag-length 2))))
|
||||
(raw-tag (hexstring->blob (string-take-right message-and-tag (* tag-length 2)))))
|
||||
(user-decrypt (blob->string raw-message) (blob->string raw-tag) user-key user-iv user-id)))
|
||||
|
||||
(define (create-user conn auth-user-id email username)
|
||||
(let ((user-key (blob->hexstring/uppercase (generate-key)))
|
||||
(user-iv (blob->hexstring/uppercase (generate-iv))))
|
||||
(receive (enc-user-key tag)
|
||||
(encrypt user-key *root-key-key* *root-key-iv* (string->blob (number->string auth-user-id)))
|
||||
;; (write user-key)
|
||||
;; (newline)
|
||||
;; (write user-iv)
|
||||
;; (newline)
|
||||
;; (write (blob->hexstring/uppercase (string->blob enc-user-key)))
|
||||
;; (newline)
|
||||
;; (write (blob->hexstring/uppercase (string->blob tag)))
|
||||
(let ((user-id
|
||||
(value-at
|
||||
(query conn
|
||||
"insert into users(auth_user_id, email, username, key_key, key_iv) values ($1, $2, $3, $4, $5)
|
||||
returning users.user_id;"
|
||||
auth-user-id email username
|
||||
(string-append (blob->hexstring/uppercase (string->blob enc-user-key))
|
||||
(blob->hexstring/uppercase (string->blob tag)))
|
||||
user-iv))))
|
||||
(query conn "insert into user_service_configs(user_id) values ($1);" user-id)
|
||||
(query conn "insert into user_selected_apps(user_id) values ($1);" user-id)
|
||||
(query conn "insert into user_app_configs(user_id) values ($1);" user-id)))))
|
||||
|
||||
(define *user-service-configs-column-map*
|
||||
'((cloudflare-api-token . ("cloudflare_api_token_enc" #t))
|
||||
(cloudflare-account-id . ("cloudflare_account_id_enc" #t))
|
||||
(cloudflare-zone-id . ("cloudflare_zone_id_enc" #t))
|
||||
(digitalocean-api-token . ("digitalocean_api_token_enc" #t))
|
||||
(digitalocean-region . ("digitalocean_region" #f))
|
||||
(digitalocean-size . ("digitalocean_size" #f))
|
||||
(backblaze-application-key . ("backblaze_application_key_enc" #t))
|
||||
(backblaze-key-id . ("backblaze_key_id_enc" #t))
|
||||
(backblaze-bucket-url . ("backblaze_bucket_url_enc" #t))))
|
||||
|
||||
(define *user-service-configs-reverse-column-map*
|
||||
(map (lambda (config)
|
||||
`(,(string->symbol (cadr config)) . (,(car config) ,(caddr config))))
|
||||
*user-service-configs-column-map*))
|
||||
|
||||
(define (update-user-service-config conn user-id update-alist)
|
||||
(let ((valid-keys (map car *user-service-configs-column-map*)))
|
||||
(for-each (lambda (update)
|
||||
(if (not (memq (car update) valid-keys))
|
||||
(error (string-append "Not a valid update key: " (->string (car update))))))
|
||||
update-alist))
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
(get-decrypted-user-key-and-iv conn user-id)
|
||||
(query* conn
|
||||
(string-append
|
||||
"update user_service_configs set "
|
||||
(string-intersperse
|
||||
(map-in-order (lambda (update i)
|
||||
(conc (car (alist-ref (car update) *user-service-configs-column-map*))
|
||||
"=$" i))
|
||||
update-alist
|
||||
(iota (length update-alist) 2))
|
||||
", ")
|
||||
" where user_id=$1;")
|
||||
(cons user-id
|
||||
(map-in-order (lambda (update)
|
||||
(if (cadr (alist-ref (car update) *user-service-configs-column-map*))
|
||||
(user-encrypt-for-db (cdr update) user-key user-iv user-id)
|
||||
(cdr update)))
|
||||
update-alist)))))
|
||||
|
||||
(define (get-user-service-config conn user-id)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
(get-decrypted-user-key-and-iv conn user-id)
|
||||
(let ((res (row-alist
|
||||
(query conn
|
||||
(string-append
|
||||
"select "
|
||||
(string-intersperse
|
||||
(map-in-order (lambda (update)
|
||||
(car (alist-ref (car update) *user-service-configs-column-map*)))
|
||||
*user-service-configs-column-map*)
|
||||
", ")
|
||||
" from user_service_configs where user_id=$1;")
|
||||
user-id))))
|
||||
(map (lambda (item)
|
||||
(let* ((key (car item))
|
||||
(value (cdr item))
|
||||
(config (alist-ref key *user-service-configs-reverse-column-map*)))
|
||||
`(,(car config) . ,(if (sql-null? value)
|
||||
""
|
||||
(if (cadr config)
|
||||
(user-decrypt-from-db value user-key user-iv user-id)
|
||||
value)))))
|
||||
res))))
|
||||
|
||||
(define *user-selected-apps-column-map*
|
||||
'((wg-easy . "wg_easy_version")
|
||||
(nextcloud . "nextcloud_version")
|
||||
(log-viewer . "log_viewer_version")))
|
||||
|
||||
(define *user-selected-apps-reverse-column-map*
|
||||
(map (lambda (config)
|
||||
`(,(string->symbol (cdr config)) . ,(car config)))
|
||||
*user-selected-apps-column-map*))
|
||||
|
||||
(define (update-user-selected-apps conn user-id app-alist)
|
||||
(let ((valid-keys (map car *user-selected-apps-column-map*)))
|
||||
(for-each (lambda (app)
|
||||
(if (not (memq (car app) valid-keys))
|
||||
(error (string-append "Not a valid app key: " (->string (car app))))))
|
||||
app-alist))
|
||||
(query* conn
|
||||
(string-append
|
||||
"update user_selected_apps set "
|
||||
(string-intersperse
|
||||
(map-in-order (lambda (app i)
|
||||
(conc (alist-ref (car app) *user-selected-apps-column-map*)
|
||||
"=$" i))
|
||||
app-alist
|
||||
(iota (length app-alist) 2))
|
||||
", ")
|
||||
" where user_id=$1;")
|
||||
(cons user-id
|
||||
(map-in-order cdr app-alist))))
|
||||
|
||||
(define (get-user-selected-apps conn user-id)
|
||||
(let ((res (row-alist
|
||||
(query conn
|
||||
(string-append
|
||||
"select "
|
||||
(string-intersperse
|
||||
(map-in-order cdr *user-selected-apps-column-map*)
|
||||
", ")
|
||||
" from user_selected_apps where user_id=$1;")
|
||||
user-id))))
|
||||
(map (lambda (item)
|
||||
(let* ((key (car item))
|
||||
(value (cdr item))
|
||||
(config (alist-ref key *user-selected-apps-reverse-column-map*)))
|
||||
`(,config . ,(if (sql-null? value)
|
||||
#f
|
||||
value))))
|
||||
res)))
|
||||
|
||||
(define (update-user-app-config conn user-id config)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
(get-decrypted-user-key-and-iv conn user-id)
|
||||
(query conn
|
||||
"update user_app_configs set config_enc=$1 where user_id=$2;"
|
||||
(user-encrypt-for-db
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(write config)))
|
||||
user-key user-iv user-id)
|
||||
user-id)))
|
||||
|
||||
(define (update-root-domain conn user-id root-domain)
|
||||
(query conn
|
||||
"update user_app_configs set root_domain=$1 where user_id=$2;"
|
||||
root-domain
|
||||
user-id))
|
||||
|
||||
(define (get-user-app-config conn user-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 root_domain, config_enc from user_app_configs where user_id=$1;"
|
||||
user-id))))
|
||||
`((root-domain . ,(if (sql-null? (alist-ref 'root_domain res))
|
||||
#f
|
||||
(alist-ref 'root_domain res)))
|
||||
(config . ,(if (sql-null? (alist-ref 'config_enc res))
|
||||
'()
|
||||
(with-input-from-string
|
||||
(user-decrypt-from-db (alist-ref 'config_enc res) user-key user-iv user-id)
|
||||
read)))))))
|
||||
|
||||
;; (with-db/transaction (lambda (db) (create-user db 1 "t@thintz.com" "thecombjelly")))
|
||||
|
||||
;; (let ((user-id 7))
|
||||
;; (with-db/transaction
|
||||
;; (lambda (db)
|
||||
;; (receive (user-key user-iv auth-user-id)
|
||||
;; (get-decrypted-user-key-and-iv db user-id)
|
||||
;; (receive (message tag)
|
||||
;; (user-encrypt "hello!" user-key user-iv user-id)
|
||||
;; (user-decrypt message tag user-key user-iv user-id))))))
|
||||
|
||||
;; (with-db/transaction
|
||||
;; (lambda (db)
|
||||
;; (update-user-service-config db 7 '((cloudflare-api-token . ")
|
||||
;; (digitalocean-region . "sfo3")))))
|
||||
|
||||
;; (with-db/transaction
|
||||
;; (lambda (db)
|
||||
;; (get-user-service-config db 7)))
|
||||
|
||||
;; (with-db/transaction
|
||||
;; (lambda (db)
|
||||
;; (update-user-selected-apps db 7 '((wg-easy . "0.1")
|
||||
;; (nextcloud . "1.3")))))
|
||||
|
||||
;; (with-db/transaction
|
||||
;; (lambda (db)
|
||||
;; (get-user-selected-apps db 7)))
|
||||
|
||||
;; (with-db/transaction
|
||||
;; (lambda (db)
|
||||
;; (update-user-app-config db 7 "domain.com" '())))
|
||||
|
||||
;; (with-db/transaction
|
||||
;; (lambda (db)
|
||||
;; (get-user-app-config db 7)))
|
||||
|
||||
)
|
||||
Loading…
Reference in New Issue