;; 组织业务:组织是仓库的分类,同时也是公开 URL 的前缀。
(defmodule lamina_org_mgr
(export all))
;;---- 查询 ----
(defun list-orgs ()
(let ((result (catch
(lamina_db:q
"SELECT o.id,o.name,o.description,o.created_at,COUNT(r.id) FROM organizations o LEFT JOIN repositories r ON r.organization_id=o.id GROUP BY o.id,o.name,o.description,o.created_at ORDER BY o.created_at ASC;"))))
(if (is_list result) result '())))
(defun get (org-id)
(case (catch (lamina_db:q
"SELECT id,name,description,created_at FROM organizations WHERE id=?;"
(list org-id)))
(`(,row) row)
(_ 'undefined)))
(defun exists? (org-id)
(case (get org-id)
('undefined 'false)
(_ 'true)))
;;---- 创建 ----
(defun create (name description)
(let ((name1 (to-str name))
(description1 (to-str description)))
(case (lamina_validate:check-slug name1)
('ok
(case (available? name1 0)
('ok
(case (catch
(lamina_db:q
"INSERT INTO organizations(name,description,created_at) VALUES(?,?,?);"
(list name1 description1 (lamina_setup:iso8601 (os:system_time 'second)))))
('ok 'ok)
('() 'ok)
(`#(error ,reason) `#(error ,(format-db-error reason)))
(_ `#(error "创建组织失败"))))
(`#(error ,message) `#(error ,message))))
(`#(error ,message) `#(error ,message))
(_ `#(error "组织名称无效")))))
;; 修改组织名会改变公开 URL;仓库文件路径保持不变,repo_mgr 会在下次
;; 启动时按新的组织名重新注册路由。
(defun update-org (org-id name description)
(let ((name1 (to-str name))
(description1 (to-str description)))
(case (lamina_validate:check-slug name1)
('ok (update-existing-org org-id name1 description1))
(`#(error ,message) `#(error ,message))
(_ `#(error "组织名称无效")))))
(defun update-existing-org (org-id name description)
(case (get org-id)
('undefined `#(error "组织不存在"))
(row
(let ((old-name (to-str (lists:nth 2 row))))
(case (available? name org-id)
('ok
(case (catch (lamina_db:q
"UPDATE organizations SET name=?,description=? WHERE id=?;"
(list name description org-id)))
('ok (finish-org-rename old-name name description org-id))
('() (finish-org-rename old-name name description org-id))
(`#(error ,reason) `#(error ,(format-db-error reason)))
(_ `#(error "更新组织失败"))))
(`#(error ,message) `#(error ,message)))))))
(defun finish-org-rename (old-name new-name description org-id)
(case (restart-org-repos old-name new-name org-id)
('ok 'ok)
(`#(error ,message)
;; 数据库名称和运行时路由必须保持一致;重启失败时恢复原名并尝试恢复旧路由。
(lamina_db:q "UPDATE organizations SET name=? WHERE id=?;" (list old-name org-id))
(catch (restart-org-repos new-name old-name org-id))
`#(error ,message))))
(defun restart-org-repos (old-name new-name org-id)
(let ((result (catch (lamina_db:q
"SELECT name,fossil_path FROM repositories WHERE organization_id=?;"
(list org-id)))))
(if (is_list result)
(let ((failures
(lists:foldl
(lambda (row acc)
(let ((slug (to-str (lists:nth 1 row)))
(path (to-str (lists:nth 2 row))))
;; 先清掉旧的 registry key,再用新组织名前缀注册。
(catch (lamina_repo_mgr:stop-repo old-name slug))
(case (catch (lamina_repo_mgr:start-repo new-name slug path))
('ok acc)
(other
(logger:error "organization rename could not restart ~s/~s: ~p"
(list new-name slug other))
(cons slug acc)))))
'() result)))
(if (=:= '() failures)
'ok
`#(error ,(lists:flatten
(io_lib:format "组织改名后以下仓库服务启动失败: ~p"
(list (lists:reverse failures)))))))
`#(error "组织改名后仓库服务刷新失败"))))
;; 只有空组织允许删除,避免仓库 URL 突然失效。
(defun delete (org-id)
(case (catch (lamina_db:q
"SELECT COUNT(*) FROM repositories WHERE organization_id=?;"
(list org-id)))
(`((,count))
(if (=:= 0 (to-int count))
(case (catch (lamina_db:q "DELETE FROM organizations WHERE id=?;" (list org-id)))
('ok 'ok)
('() 'ok)
(`#(error ,reason) `#(error ,(format-db-error reason)))
(_ `#(error "删除组织失败")))
`#(error "组织中仍有仓库,不能删除")))
(_ `#(error "组织不存在"))))
;; 组织名不能与 project 分组中的仓库名相同,否则 /name/path 的路由
;; 语义会产生歧义;组织自身则由数据库 UNIQUE 约束保证唯一。
(defun available? (name exclude-id)
(case (catch (lamina_db:q
"SELECT COUNT(*) FROM organizations WHERE name=? AND id<>?;"
(list name exclude-id)))
(`((,org-count))
(if (> (to-int org-count) 0)
`#(error "该组织名称已存在")
(case (catch (lamina_db:q
"SELECT COUNT(*) FROM repositories WHERE name=? AND organization_id IS NULL;"
(list name)))
(`((,repo-count))
(if (> (to-int repo-count) 0)
`#(error "该名称已被 project 仓库占用")
'ok))
(_ `#(error "无法检查组织名称")))))
(_ `#(error "无法检查组织名称"))))
(defun format-db-error (reason)
(lists:flatten (io_lib:format "数据库错误: ~p" (list reason))))
(defun to-int (value)
(cond
((is_integer value) value)
((is_binary value) (binary_to_integer value))
('true (list_to_integer value))))
(defun to-str (value)
(cond
((is_binary value) (binary_to_list value))
((is_list value) value)
((or (=:= 'undefined value) (=:= 'null value)) "")
('true (lists:flatten (io_lib:format "~p" (list value))))))