(defmodule nemoptera_repo
(export all))
(defun list-all ()
(case (nemoptera_db:q
"SELECT r.id, r.name, COALESCE(o.name,''), r.description, r.source,
COALESCE(r.remote_url,''), r.sync_interval_minutes,
COALESCE(r.last_timeline_at,''), COALESCE(r.last_sync_status,''),
COALESCE(r.last_push_status,''), r.git_enabled
FROM repositories r
LEFT JOIN organizations o ON o.id=r.organization_id
ORDER BY o.name COLLATE NOCASE, r.name COLLATE NOCASE;" '())
(rows (when (is_list rows))
(lists:map #'summary/1 rows))
(_ '())))
(defun summary (row)
(let* (((tuple id name org description source remote interval timeline sync-status push-status git-enabled) (nemoptera_db:as-tuple row))
(org-name (blank-none org)))
(maps:from_list
(list (tuple 'id id)
(tuple 'name (nemoptera_text:to-str name))
(tuple 'org org-name)
(tuple 'description (nemoptera_text:to-str description))
(tuple 'source (nemoptera_text:to-str source))
(tuple 'remote_url (nemoptera_text:to-str remote))
(tuple 'sync_interval (nemoptera_text:to-int interval 0))
(tuple 'timeline (nemoptera_text:to-str timeline))
(tuple 'sync_status (nemoptera_text:to-str sync-status))
(tuple 'push_status (nemoptera_text:to-str push-status))
(tuple 'git_enabled (nemoptera_text:to-int git-enabled 0))
(tuple 'url (nemoptera_site:repo-path org-name name))))))
(defun fetch (id)
(case (nemoptera_db:q
"SELECT r.id, r.name, r.organization_id, COALESCE(o.name,''), r.description, r.source,
COALESCE(r.remote_url,''), r.sync_interval_minutes, r.setup_username,
r.setup_password_enc, r.git_enabled, COALESCE(r.git_url,''), COALESCE(r.git_username,''),
COALESCE(r.git_token_enc,''), r.git_auto_push, r.fossil_path,
COALESCE(r.last_timeline_at,''), COALESCE(r.last_synced_at,''), COALESCE(r.last_sync_status,''),
COALESCE(r.last_pushed_at,''), COALESCE(r.last_push_status,'')
FROM repositories r LEFT JOIN organizations o ON o.id=r.organization_id
WHERE r.id=?;" (list id))
(`(,row) `#(ok ,(detail row)))
(_ `#(error "Repository not found."))))
(defun detail (row)
(let (((tuple id name org-id org description source remote interval setup-user setup-enc
git-enabled git-url git-user git-token git-auto path timeline synced sync-status
pushed push-status) (nemoptera_db:as-tuple row)))
(maps:from_list
(list (tuple 'id id)
(tuple 'name (nemoptera_text:to-str name))
(tuple 'organization_id (id-or-none org-id))
(tuple 'org (blank-none org))
(tuple 'description (nemoptera_text:to-str description))
(tuple 'source (nemoptera_text:to-str source))
(tuple 'remote_url (nemoptera_text:to-str remote))
(tuple 'sync_interval (nemoptera_text:to-int interval 0))
(tuple 'setup_username (nemoptera_text:to-str setup-user))
(tuple 'setup_password_enc (nemoptera_text:to-str setup-enc))
(tuple 'git_enabled (nemoptera_text:to-int git-enabled 0))
(tuple 'git_url (nemoptera_text:to-str git-url))
(tuple 'git_username (nemoptera_text:to-str git-user))
(tuple 'git_token_enc (nemoptera_text:to-str git-token))
(tuple 'git_auto_push (nemoptera_text:to-int git-auto 0))
(tuple 'fossil_path (nemoptera_text:to-str path))
(tuple 'timeline (nemoptera_text:to-str timeline))
(tuple 'last_synced_at (nemoptera_text:to-str synced))
(tuple 'sync_status (nemoptera_text:to-str sync-status))
(tuple 'last_pushed_at (nemoptera_text:to-str pushed))
(tuple 'push_status (nemoptera_text:to-str push-status))
(tuple 'url (nemoptera_site:repo-path (blank-none org) name))))))
(defun create (fields)
(let ((name (string:trim (maps:get 'name fields "")))
(description (maps:get 'description fields ""))
(setup-user (string:trim (maps:get 'setup_username fields "")))
(setup-password (maps:get 'setup_password fields ""))
(source (source-of fields))
(remote (string:trim (maps:get 'remote_url fields "")))
(org-id (maps:get 'organization_id fields 'none)))
(case (prepare-org org-id)
(`#(ok ,org-name ,org-db)
(case (nemoptera_validate:check-repo-path org-name name 0)
('ok
(cond
((nemoptera_text:blank? setup-user) `#(error "Setup username is required."))
((nemoptera_text:blank? setup-password) `#(error "Setup password is required."))
((and (=:= source "remote") (nemoptera_text:blank? remote))
`#(error "Remote Fossil URL is required."))
('true (create-record fields name description setup-user setup-password source remote org-name org-db))))
(error error)))
(error error))))
(defun prepare-org (org-id)
(cond
((or (=:= org-id 'none) (=:= org-id 0) (=:= org-id "0") (=:= org-id ""))
`#(ok none none))
('true
(case (nemoptera_org:fetch (nemoptera_text:to-int org-id 0))
(`#(ok ,org) `#(ok ,(maps:get 'name org) ,(maps:get 'id org)))
(error error)))))
(defun create-record (fields name description setup-user setup-password source remote org-name org-db)
(let* ((now (nemoptera_text:now-iso))
(pending (lists:flatten (io_lib:format "pending-~p" (list (erlang:unique_integer)))))
(org-value (if (=:= org-db 'none) 'undefined org-db))
(inserted (nemoptera_db:q
"INSERT INTO repositories(name,organization_id,description,source,remote_url,sync_interval_minutes,setup_username,setup_password_enc,git_enabled,git_url,git_username,git_token_enc,git_auto_push,fossil_path,created_at,updated_at) VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);"
(list name org-value description source (blank-null remote)
(interval-of fields) setup-user (nemoptera_crypto:seal setup-password)
(flag fields 'git_enabled) (blank-null (maps:get 'git_url fields ""))
(blank-null (maps:get 'git_username fields ""))
(seal-optional (maps:get 'git_token fields ""))
(flag fields 'git_auto_push) pending now now))))
(case inserted
(`#(error ,reason) `#(error ,(nemoptera_text:clip (io_lib:format "~p" (list reason)) 400)))
(`#(EXIT ,reason) `#(error ,(nemoptera_text:clip (io_lib:format "~p" (list reason)) 400)))
(_
(let* ((id (nemoptera_db:insert-id))
(path (filename:absname (filename:join (nemoptera_config:repo-dir)
(lists:flatten (list (integer_to_list id) ".fossil"))))))
(filelib:ensure_dir path)
(nemoptera_db:q "UPDATE repositories SET fossil_path=? WHERE id=?;" (list path id))
(case (materialize source remote path setup-user setup-password name description)
('ok
(let ((stamp (nemoptera_fossil_repo:last-timeline path)))
(nemoptera_db:q "UPDATE repositories SET last_timeline_at=? WHERE id=?;"
(list (blank-null stamp) id))
(case (nemoptera_mgr:start-repo org-name name path)
('ok `#(ok ,id))
(`#(error ,reason)
(fail-create id path (nemoptera_fossil:error-message reason))))))
(`#(error ,message) (fail-create id path message))))))))
(defun materialize (source remote path setup-user setup-password name description)
(let ((made (if (=:= source "remote")
(nemoptera_fossil_repo:clone remote path setup-user)
(nemoptera_fossil_repo:init path setup-user name description))))
(case made
(`#(ok ,_)
(case (nemoptera_fossil_repo:set-user-password path setup-user setup-password)
(`#(ok ,_)
(nemoptera_fossil_repo:set-setup-capability path setup-user)
(if (=:= source "remote")
(nemoptera_fossil_repo:set-description path name description)
'ok)
(case (nemoptera_fossil_repo:configure-web path)
(`#(ok ,_) 'ok)
(`#(error ,reason) `#(error ,(nemoptera_fossil:error-message reason)))))
(`#(error ,reason) `#(error ,(nemoptera_fossil:error-message reason)))))
(`#(error ,reason) `#(error ,(nemoptera_fossil:error-message reason))))))
(defun fail-create (id path message)
(catch (file:delete path))
(catch (nemoptera_db:q "DELETE FROM repositories WHERE id=?;" (list id)))
`#(error ,message))
(defun update (id fields)
(case (fetch id)
(`#(ok ,repo)
(let* ((name (string:trim (maps:get 'name fields (maps:get 'name repo))))
(org-id (maps:get 'organization_id fields (maps:get 'organization_id repo))))
(case (prepare-org org-id)
(`#(ok ,org-name ,org-db)
(case (nemoptera_validate:check-repo-path org-name name id)
('ok (update-record repo fields name org-name org-db))
(error error)))
(error error))))
(error error)))
(defun update-record (repo fields name org-name org-db)
(let* ((id (maps:get 'id repo))
(description (maps:get 'description fields (maps:get 'description repo)))
(setup-user (string:trim (maps:get 'setup_username fields (maps:get 'setup_username repo))))
(setup-password (maps:get 'setup_password fields ""))
(remote (string:trim (maps:get 'remote_url fields (maps:get 'remote_url repo))))
(path (maps:get 'fossil_path repo))
(password-enc (if (nemoptera_text:blank? setup-password)
(maps:get 'setup_password_enc repo)
(nemoptera_crypto:seal setup-password)))
(token (maps:get 'git_token fields ""))
(token-enc (if (nemoptera_text:blank? token)
(maps:get 'git_token_enc repo)
(nemoptera_crypto:seal token))))
(cond
((nemoptera_text:blank? setup-user) `#(error "Setup username is required."))
((and (=:= (maps:get 'source repo) "remote") (nemoptera_text:blank? remote))
`#(error "Remote Fossil URL is required."))
('true
(case (apply-fossil repo path name description setup-user setup-password)
('ok
(nemoptera_db:q
"UPDATE repositories SET name=?, organization_id=?, description=?, remote_url=?, sync_interval_minutes=?, setup_username=?, setup_password_enc=?, git_enabled=?, git_url=?, git_username=?, git_token_enc=?, git_auto_push=?, updated_at=? WHERE id=?;"
(list name (if (=:= org-db 'none) 'undefined org-db)
description (blank-null remote) (interval-of fields) setup-user password-enc
(flag fields 'git_enabled) (blank-null (maps:get 'git_url fields ""))
(blank-null (maps:get 'git_username fields "")) token-enc
(flag fields 'git_auto_push) (nemoptera_text:now-iso) id))
(restart-if-moved repo name org-name path)
'ok)
(error error))))))
(defun apply-fossil (repo path name description setup-user setup-password)
(case (nemoptera_fossil_repo:set-description path name description)
(`#(error ,reason) `#(error ,(nemoptera_fossil:error-message reason)))
(_
(let ((user-result (if (=:= setup-user (maps:get 'setup_username repo))
'ok
(nemoptera_fossil:run (list "user" "new" setup-user "" setup-password "-R" path)))))
(case user-result
(`#(error ,reason) `#(error ,(nemoptera_fossil:error-message reason)))
(_
(nemoptera_fossil_repo:set-setup-capability path setup-user)
(if (nemoptera_text:blank? setup-password)
'ok
(case (nemoptera_fossil_repo:set-user-password path setup-user setup-password)
(`#(error ,reason) `#(error ,(nemoptera_fossil:error-message reason)))
(_ 'ok)))))))))
(defun restart-if-moved (repo name org-name path)
(let ((old-org (maps:get 'org repo))
(old-name (maps:get 'name repo)))
(if (and (=:= old-name name)
(=:= (nemoptera_registry:norm-org old-org) (nemoptera_registry:norm-org org-name)))
'ok
(progn
(nemoptera_mgr:stop-repo old-org old-name)
(nemoptera_mgr:start-repo org-name name path)))))
(defun delete (id)
(case (fetch id)
(`#(ok ,repo)
(nemoptera_mgr:stop-repo (maps:get 'org repo) (maps:get 'name repo))
(file:delete (maps:get 'fossil_path repo))
(file:del_dir_r (lists:flatten (list (maps:get 'fossil_path repo) ".git")))
(nemoptera_db:q "DELETE FROM sync_log WHERE repository_id=?;" (list id))
(nemoptera_db:q "DELETE FROM push_log WHERE repository_id=?;" (list id))
(nemoptera_db:q "DELETE FROM repositories WHERE id=?;" (list id))
'ok)
(error error)))
(defun source-of (fields)
(if (=:= (maps:get 'source fields "local") "remote") "remote" "local"))
(defun interval-of (fields)
(max 0 (nemoptera_text:to-int (maps:get 'sync_interval fields 0) 0)))
(defun flag (fields key)
(if (=:= (maps:get key fields 0) 1) 1 0))
(defun seal-optional (value)
(if (nemoptera_text:blank? value) "" (nemoptera_crypto:seal value)))
(defun blank-null (value)
(if (or (nemoptera_text:blank? value) (=:= (nemoptera_text:to-str value) "unknown"))
'undefined
(nemoptera_text:to-str value)))
(defun blank-none (value)
(let ((text (nemoptera_text:to-str value)))
(if (=:= "" text) 'none text)))
(defun id-or-none (value)
(cond
((is_integer value) value)
((is_binary value) (nemoptera_text:to-int value 'none))
('true 'none)))