(defmodule lamina_m7_tests
(export all)
(include-lib "eunit/include/eunit.hrl"))
(defun site-settings-and-password-change_test ()
(with-db
(lambda ()
(let ((hash (lamina_crypto:hash_password #"old-password")))
(lamina_db:q
"INSERT INTO admin_user(username,password_hash,created_at,updated_at) VALUES('admin',?,?,?);"
(list hash "now" "now"))
(case (lamina_site_mgr:update
(maps:from_list
(list (tuple 'site_name "Acme Fossil") (tuple 'site_url "https://fossil.example")
(tuple 'site_tagline "Ship carefully") (tuple 'site_description "Projects")
(tuple 'footer_text "Acme") (tuple 'footer_terms_url "/terms")
(tuple 'footer_privacy_url "/privacy") (tuple 'footer_contact_url "/contact"))))
('ok 'ok)
(other (erlang:error (list "settings update failed" other))))
(if (=:= "Acme Fossil" (lamina_site_mgr:site-name))
'ok
(erlang:error "site name was not saved"))
(case (lamina_site_mgr:change-admin-password
"admin" #"old-password" #"new-password" #"new-password")
('ok 'ok)
(other (erlang:error (list "password change failed" other))))
(if (and (not (lamina_auth:check-credentials "admin" #"old-password"))
(lamina_auth:check-credentials "admin" #"new-password"))
'ok
(erlang:error "password change did not invalidate the old password"))))))
(defun dashboard-has-real-metrics_test ()
(let* ((dir (tmpdir))
(repo-dir (filename:join dir "repos"))
(repo-file (filename:join repo-dir "demo.fossil")))
(filelib:ensure_dir repo-file)
(file:write_file repo-file (binary:copy #"x" 2048))
(lamina_config:put (maps:from_list (list (tuple 'repo_dir repo-dir))))
(with-db
(lambda ()
(lamina_db:exec "INSERT INTO organizations(name,description,created_at) VALUES('team','',datetime('now'));" )
(let ((org-id (lamina_db:last-rowid)))
(lamina_db:q
"INSERT INTO repositories(name,organization_id,display_name,description,source,setup_username,setup_password_enc,fossil_path,last_timeline_at,created_at,updated_at) VALUES('demo',?,?,?,'local','admin',x'00',?,datetime('now'),datetime('now'),datetime('now'));"
(list org-id "Demo" "" repo-file))
(let ((body (lists:flatten (lamina_admin_pages:dashboard-body "admin"))))
(cleanup dir)
(if (and (/= 'nomatch (string:find body "Storage Used"))
(/= 'nomatch (string:find body "Recently Updated"))
(/= 'nomatch (string:find body "Demo"))
(/= 'nomatch (string:find body "2.0 KB")))
'ok
(erlang:error (list "dashboard metrics missing" body)))))))))
(defun unified-error-page_test ()
(let ((response (lamina_error_pages:service-unavailable "retry later")))
(if (and (=:= 'status (element 1 response))
(=:= 503 (element 2 response))
(/= 'nomatch (binary:match (element 4 response) #"Repository is starting")))
'ok
(erlang:error "503 page was not rendered"))))
(defun setup-escapes-user-input_test ()
(let ((body (lists:flatten
(lamina_setup_pages:field "site_name" "Name" "<script>alert(1)</script>\""))))
(if (and (=:= 'nomatch (string:find body "<script>"))
(/= 'nomatch (string:find body "<script>"))
(/= 'nomatch (string:find body """)))
'ok
(erlang:error (list "setup input was not escaped" body)))))
(defun sync-validation-is-logged_test ()
(with-db
(lambda ()
(lamina_db:q
"INSERT INTO repositories(name,display_name,description,source,remote_url,setup_username,setup_password_enc,fossil_path,created_at,updated_at) VALUES('broken','broken','','remote','', 'admin',x'00','broken.fossil','now','now');")
(let ((repo-id (lamina_db:last-rowid)))
(case (lamina_sync_task:run-sync repo-id)
(`#(error ,_)
(let ((status (lamina_db:q "SELECT last_sync_status FROM repositories WHERE id=?;" (list repo-id)))
(log (lamina_db:q "SELECT status,message FROM sync_log WHERE repository_id=?;" (list repo-id))))
(if (and (=:= `((#"failed")) status)
(=:= #"failed" (lists:nth 1 (hd log)))
(/= #"" (lists:nth 2 (hd log))))
'ok
(erlang:error (list "validation failure was not logged" status log)))))
(other (erlang:error (list "missing remote URL was accepted" other))))))))
(defun empty-skin-reapply_test ()
(with-db
(lambda ()
(case (lamina_site_mgr:reapply-skin-all)
(`#(ok 0) 'ok)
(other (erlang:error (list "empty skin reapply failed" other)))))))
(defun with-db (f)
(let* ((cwd (element 2 (file:get_cwd)))
(dir (filename:join cwd "_build/tmp/m7-tests"))
(path (filename:join dir (lists:flatten (io_lib:format "db-~p.db" (list (os:system_time 'microsecond)))))))
(filelib:ensure_dir path)
(let ((open-result (lamina_db:open path)))
(if (and (is_tuple open-result) (=:= 'ok (element 1 open-result)))
(let ((result (catch (funcall f))))
(lamina_db:close)
(catch (file:delete path))
(if (=:= 'ok result) 'ok (erlang:error result)))
(erlang:error (list "database setup failed" open-result))))))
(defun parse-nav-menu-skips-invalid-lines_test ()
(let ((items (lamina_site_mgr:parse-nav-menu
"Docs | https://example.com/docs\nBad\njavascript:alert(1) | x\nBlog | /blog\nEvil | //evil.example")))
(case items
(`(,docs ,blog)
(if (and (=:= "Docs" (maps:get 'label docs))
(=:= "https://example.com/docs" (maps:get 'url docs))
(=:= "Blog" (maps:get 'label blog))
(=:= "/blog" (maps:get 'url blog)))
'ok
(erlang:error (list "unexpected nav items" items))))
(_ (erlang:error (list "nav parse failed" items))))))
(defun org-repo-registry-keys-match_test ()
(let ((from-db (lamina_repo_registry:key #"test" #"lotus"))
(from-url (lamina_repo_registry:key "test" "lotus")))
(if (=:= from-db from-url)
'ok
(erlang:error (list "org repo registry keys diverged" from-db from-url)))))
(defun tmpdir ()
(let* ((cwd (element 2 (file:get_cwd)))
(base (filename:join cwd "_build/tmp"))
(name (lists:flatten (io_lib:format "m7-~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 cleanup (dir)
(catch (file:del_dir_r dir)))