(defmodule lamina_repo_server_tests
(export all)
(include-lib "eunit/include/eunit.hrl"))
(defun server-args-put-options-before-repository_test ()
(lamina_config:put #M(site_url "https://example.test"))
(let ((args (lamina_repo_server:server-args 'none "demo" "data/repos/demo.fossil" 23456)))
(let ((repo (lists:last args)))
(if (and (=:= "server" (hd args))
(lists:member "--localhost" args)
(lists:member "--nojail" args)
(lists:member "--https" args)
(lists:member "--baseurl" args)
(lists:member "23456" args)
(/= 'nomatch (string:find repo "demo.fossil"))
(not (lists:member "demo.fossil" (lists:droplast args))))
'ok
(erlang:error (list "server-args order failed" args))))))
(defun start-error-text-explains-noproc_test ()
(let ((msg (lamina_repo_ctl:start-error-text
(tuple 'noproc (tuple 'gen_server 'call (list 'lamina_repo_mgr))))))
(if (/= 'nomatch (string:find msg "未就绪"))
'ok
(erlang:error (list "noproc message failed" msg)))))
(defun start-repo-without-mgr-matches-old-ui-error_test ()
;; 旧代码把 gen_server:call 的 EXIT 收成「仓库进程启动失败」。
(case (whereis 'lamina_repo_mgr)
('undefined
(case (catch (lamina_repo_mgr:start-repo 'none "demo" "/tmp/missing.fossil"))
(`#(EXIT ,reason)
(let ((new (lamina_repo_ctl:start-error-text reason)))
(if (and (/= 'nomatch (string:find (lists:flatten (io_lib:format "~p" (list reason))) "noproc"))
(/= 'nomatch (string:find new "未就绪")))
'ok
(erlang:error (list "noproc handling changed unexpectedly" reason new)))))
(other (erlang:error (list "expected EXIT when repo_mgr is missing" other)))))
(_ 'ok)))
(defun repo-server-listens-after-start-link_test ()
(require-fossil)
(process_flag 'trap_exit 'true)
(let* ((dir (tmpdir))
(home (filename:join dir "home"))
(path (filename:join dir "demo.fossil")))
(filelib:ensure_dir (filename:join home "x"))
(lamina_config:put (maps:from_list
(list (tuple 'site_url "https://hgrc.dev")
(tuple 'fossil_home home)
(tuple 'repo_dir dir))))
(case (lamina_fossil_repo:init path "admin")
(`#(ok ,_)
(ensure-registry)
(case (lamina_repo_server:start-link 'none "demo" path)
(`#(ok ,pid)
(let ((portnum (lamina_repo_server:get-port "demo")))
(application:ensure_all_started 'inets)
(let ((http (httpc:request 'get
(tuple (lists:flatten
(io_lib:format "http://127.0.0.1:~p/" (list portnum)))
'())
(list (tuple 'timeout 3000)
(tuple 'autoredirect 'false))
'())))
(unlink pid)
(catch (gen_server:stop pid 'shutdown 3000))
(cleanup dir)
(case http
((tuple 'ok (tuple (tuple _ status _) _ _))
(if (and (is_integer portnum) (>= status 200) (=< status 399))
'ok
(erlang:error (list "unexpected fossil http status" status portnum))))
(other (erlang:error (list "fossil http failed" portnum other)))))))
(other
(cleanup dir)
(erlang:error (list "repo_server start-link failed" other)))))
(other (cleanup dir) (erlang:error (list "fossil init failed" other))))))
(defun create-local-starts-repo-process_test ()
(require-fossil)
(process_flag 'trap_exit 'true)
(let* ((dir (tmpdir))
(home (filename:join dir "home"))
(repos (filename:join dir "repos"))
(db (filename:join dir "platform.db"))
(key (crypto:hash 'sha256 #"repo-server-test-key")))
(filelib:ensure_dir (filename:join home "x"))
(filelib:ensure_dir (filename:join repos "x"))
(lamina_auth:put-secret-key key)
(lamina_config:put (maps:from_list
(list (tuple 'site_url "https://hgrc.dev")
(tuple 'fossil_home home)
(tuple 'repo_dir repos)
(tuple 'db_path db))))
(case (lamina_db:open db)
(`#(ok ,_)
(ensure-registry)
(ensure-mgr)
(let ((result (lamina_repo_ctl:create-local 'none "probe" "probe" "test repo"
"admin" #"s3cret12")))
(let ((portnum (lamina_repo_server:get-port "probe"))
(status (lamina_repo_mgr:status "probe")))
(catch (lamina_repo_mgr:stop-repo "probe"))
(unlink-if-pid (whereis 'lamina_repo_mgr))
(unlink-if-pid (whereis 'lamina_repo_registry))
(lamina_db:close)
(cleanup dir)
(if (and (=:= 'ok result)
(is_integer portnum)
(is_tuple status)
(=:= 'ok (element 1 status)))
'ok
(erlang:error (list "create-local did not start repo server"
result portnum status))))))
(other (cleanup dir) (erlang:error (list "db open failed" other))))))
(defun require-fossil ()
(let ((bin (lamina_config:fossil-bin)))
(if (is_atom bin)
(erlang:error "PATH 中没有 fossil，无法做进程启动实测")
bin)))
(defun ensure-registry ()
(case (lamina_repo_registry:start-link)
(`#(ok ,pid) pid)
(`#(error #(already_started ,pid)) pid)
(other (erlang:error (list "registry start failed" other)))))
(defun ensure-mgr ()
(case (lamina_repo_mgr:start-link)
(`#(ok ,pid) pid)
(`#(error #(already_started ,pid)) pid)
(other (erlang:error (list "repo_mgr start failed" other)))))
(defun tmpdir ()
(let* ((cwd (element 2 (file:get_cwd)))
(base (filename:join cwd "_build/tmp"))
(name (lists:flatten (io_lib:format "repo-server-~p" (list (os:system_time 'microsecond))))))
(filelib:ensure_dir (filename:join base "x"))
(let ((dir (filename:join base name)))
(file:make_dir dir)
dir)))
(defun unlink-if-pid (pid)
(if (is_pid pid) (catch (unlink pid)) 'ok))
(defun cleanup (dir)
(catch (file:del_dir_r dir))
'ok)