(defmodule nemoptera_validate
(export all))
(defun reserved ()
'("login" "logout" "setup" "admin" "timeline" "rss" "atom"
"organizations" "static" "favicon.ico" "robots.txt" "assets"))
(defun check-slug (slug)
(let ((name (nemoptera_text:to-str slug)))
(cond
((nemoptera_text:blank? name) `#(error "Name is required."))
((lists:member (string:lowercase name) (reserved))
`#(error "That name is reserved."))
((case (re:run name "^[A-Za-z0-9][A-Za-z0-9-]{0,63}$")
(`#(match ,_) 'false)
(_ 'true))
`#(error "Use letters, numbers, and hyphens, starting with a letter or number."))
('true 'ok))))
(defun check-repo-path (org-name slug except-id)
(case (check-slug slug)
('ok (path-free? org-name slug except-id))
(error error)))
(defun check-org-name (name except-id)
(case (check-slug name)
('ok
(cond
((org-taken? name except-id) `#(error "An organization with that name already exists."))
((loose-repo-taken? name) `#(error "That name is already used by a repository."))
('true 'ok)))
(error error)))
(defun path-free? (org-name slug except-id)
(cond
((and (=:= org-name 'none) (org-taken? slug 0))
`#(error "That name is already used by an organization."))
((repo-taken? org-name slug except-id)
`#(error "That repository path is already in use."))
('true 'ok)))
(defun org-taken? (name except-id)
(case (nemoptera_db:q "SELECT id FROM organizations WHERE name=? AND id<>?;" (list name except-id))
(`((,_)) 'true)
(_ 'false)))
(defun loose-repo-taken? (name)
(case (nemoptera_db:q "SELECT id FROM repositories WHERE name=? AND organization_id IS NULL;" (list name))
(`((,_)) 'true)
(_ 'false)))
(defun repo-taken? (org-name slug except-id)
(let ((rows (if (=:= org-name 'none)
(nemoptera_db:q "SELECT id FROM repositories WHERE name=? AND organization_id IS NULL AND id<>?;"
(list slug except-id))
(nemoptera_db:q "SELECT r.id FROM repositories r JOIN organizations o ON o.id=r.organization_id WHERE r.name=? AND o.name=? AND r.id<>?;"
(list slug org-name except-id)))))
(case rows
(`((,_)) 'true)
(_ 'false))))