server.mini

#!/usr/local/bin/minilang
gir: glib("GLib")
gir: soup("Soup")
gir: gobject("GObject")

def (sqlite) in library("sqlite")
library("zlog")::logger: log()

sqlite: DB("main.db", sqlite::open::READWRITE + sqlite::open::CREATE)

DB:execute('CREATE TABLE IF NOT EXISTS users(
	name STRING PRIMARY KEY,
	passwd STRING,
	salt STRING,
	role STRING
)')

DB:execute('CREATE TABLE IF NOT EXISTS projects(
	id INTEGER PRIMARY KEY,
	name STRING,
	source STRING,
	branch STRING,
	destination STRING,
	tag STRING,
	state STRING,
	version INTEGER
)')

DB:execute('CREATE TABLE IF NOT EXISTS tasks(
	id INTEGER PRIMARY KEY,
	project INTEGER,
	type STRING,
	state STRING,
	time STRING
)')

DB:execute('CREATE TABLE IF NOT EXISTS members(
	project INTEGER,
	user STRING,
	role STRING
)')

do
	DB:execute('insert into users(name, passwd, salt, role) values(?, ?, ?, ?)', 'Bob1', "******", "", "admin")
on Error do
	log::error(Error)
end

for Row in DB:execute("select * from users") do
	print(Row, "\n")
end

let Loop := glib::MainLoop::new(nil, nil)

def Projects := {}
def ProjectPath := glib::canonicalize_filename("projects", nil)

let ProjectCreateStmt := DB:statement("INSERT INTO projects(name, source, branch, destination, tag, state, version) VALUES(?, ?, ?, ?, ?, 'CLONING', 0) RETURNING id")
let ProjectRepoStmt := DB:statement("SELECT source, branch FROM projects WHERE id = ?")
let ProjectUpdateStateStmt := DB:statement("UPDATE projects SET state = ? WHERE id = ?")
let ProjectUpdateVersionStmt := DB:statement("UPDATE projects SET version = ? WHERE id = ?")

class: project(:Id, :Name, :Destination, :Tag, :State, :Version, :Tasks, :Next,
	state is enum(
		"CREATING", "CREATE_SUCCESS", "CREATE_ERROR",
		"CLEANING", "CLEAN_SUCCESS", "CLEAN_ERROR",
		"CLONING", "CLONE_SUCCESS", "CLONE_ERROR",
		"PREPARING", "PREPARE_SUCCESS", "PREPARE_ERROR",
		"PULLING", "PULL_SUCCESS", "PULL_ERROR",
		"BUILDING", "BUILD_SUCCESS", "BUILD_ERROR",
		"PACKAGING", "PACKAGE_SUCCESS", "PACKAGE_ERROR",
		"PUSHING", "PUSH_SUCCESS", "PUSH_ERROR"
	)
)

fun project_create(Name, URL, Branch, Destination, Tag) do
	let Id := last(ProjectCreateStmt(Name, URL, Branch, Destination, Tag))[1]
	log::info('Project created ', Id, ' ', Name, ' ', URL, ' ', Branch)
	glib::mkdir_with_parents('{ProjectPath}/{Id}/context', 511)
	glib::mkdir_with_parents('{ProjectPath}/{Id}/workspace', 511)
	let Project := Projects[Id] := project(Id, Name, Destination, Tag, project::state::CLONING, 0, [])
	Project:task(project::state::CLONING, ["/usr/bin/git", "clone", "-v", "--recursive", "-b", Branch, URL, '{ProjectPath}/{Project:Id}/workspace/source'])
	ret Project
end

for (Id, Name, Destination, Tag, State, Version) in DB:execute("SELECT id, name, destination, tag, state, version FROM projects") do
	Projects[Id] := project(Id, Name, Destination, Tag, project::state(State), Version, [])
end

def TaskPath := glib::canonicalize_filename("tasks", nil)

let TaskCreateStmt := DB:statement("INSERT INTO tasks(project, type, state, time) VALUES(?, ?, 'RUNNING', datetime('now')) RETURNING id")
let TaskUpdateStmt := DB:statement("UPDATE tasks SET state = ? WHERE id = ?")

class: task(:Id, :Type, :State,
	state is enum("RUNNING", "SUCCESS", "ERROR")
)

for (ProjectId, Id, Type, State) in DB:execute("SELECT project, id, type, state FROM tasks WHERE time > datetime('now','-1 hour') ORDER BY id") do
	let Project := Projects[ProjectId] or next
	Project:Tasks:put(task(Id, Type, task::state(State)))
end

meth :task(Project: project, State: project::state, Command: list[string]) do
	log::info('Task create ', Command)
	let Id := last(TaskCreateStmt(Project:Id, string(State)))[1]
	with Task := task(Id, string(State), task::state::RUNNING) do
		Project:Tasks:put(Task)
		let TaskRoot := 'tasks/{Id}/'
		glib::mkdir_with_parents(TaskRoot, 511)
		let Out := glib::IOChannel::new_file('{TaskRoot}/out.log', "w")
		let OutFd := Out:unix_get_fd
		let (_, Pid) := glib::spawn_async_with_fds(nil, Command, nil, glib::SpawnFlags::do_not_reap_child, nil, -1, OutFd, OutFd)
		Out:shutdown(false)
		Project:State := State
		glib::child_watch_add(200, Pid; Pid, Status) do
			log::info('Task complete ', Pid, ' ', Status)
			glib::spawn_close_pid(Pid)
			if Status = 0 then
				Project:State := project::state(old + 1)
				Task:State := task::state::SUCCESS
			else
				Project:State := project::state(old + 2)
				Task:State := task::state::ERROR
			end
			last(ProjectUpdateStateStmt(string(Project:State), Project:Id))
			last(TaskUpdateStmt(string(Task:State), Task:Id))
			replace(Project:Next, 0)(Project)
		end
	on Error do
		log::error(Error)
		Project:State := project::state(old + 2)
		last(ProjectUpdateStateStmt(string(Project:State), Project:Id))
		Task:State := task::state::ERROR
		last(TaskUpdateStmt(string(Task:State), Task:Id))
		replace(Project:Next, 0)(Project)
	end
end

meth :build(Project: project) do
	log::info('Building project ', Project, ': current status=', string(Project:State))
	if Project:State % 3 = 1 then
		ret Project:Next := :build
	end
	print('Project:State = {type(Project:State)}\n')
	switch Project:State: project::state
	case "CREATE_SUCCESS" do
		Project:Next := :build
		Project:task(project::state::CLEANING, ["/usr/bin/rm", "-rfv", '{ProjectPath}/{Project:Id}/workspace/source'])
		ret
	case "CLEAN_SUCCESS" do
		Project:Next := :build
		let (URL, Branch) := last(ProjectRepoStmt(Project:Id))
		Project:task(project::state::CLONING, ["/usr/bin/git", "clone", "-v", "--recursive", "-b", Branch, URL, '{ProjectPath}/{Project:Id}/workspace/source'])
		ret
	case "CLONE_SUCCESS" do
		Project:Next := :build
		Project:task(project::state::PREPARING, ["/usr/bin/podman", "build", "--squash", "-f", '{ProjectPath}/{Project:Id}/BuildSpec', "-t", 'builder-{Project:Id}', '{ProjectPath}/{Project:Id}/context'])
		ret
	case "PREPARE_SUCCESS" do
		Project:Next := :build
		Project:task(project::state::PULLING, ["/usr/bin/git", "-C", '{ProjectPath}/{Project:Id}/workspace/source', "pull", "--recurse-submodules"])
		ret
	case "PULL_SUCCESS" do
		Project:Next := :build
		Project:task(project::state::BUILDING, ["/usr/bin/podman", "run", "--network", "host", "-v", '{ProjectPath}/{Project:Id}/workspace:/workspace', "--read-only", 'builder-{Project:Id}'])
	case "BUILD_SUCCESS" do
		Project:Next := :build
		Project:Version := old + 1
		last(ProjectUpdateVersionStmt(Project:Version, Project:Id))
		let Tag := Project:Tag:replace("$VERSION", string(Project:Version))
		Project:task(project::state::PACKAGING, ["/usr/bin/podman", "build", "-v", '{ProjectPath}/{Project:Id}/workspace:/workspace', "--squash", "-f", '{ProjectPath}/{Project:Id}/PackageSpec', "-t", Tag, '{ProjectPath}/{Project:Id}/context'])
	case "PACKAGE_SUCCESS" do
		Project:Next := :build
		let Tag := Project:Tag:replace("$VERSION", string(Project:Version))
		Project:task(project::state::PUSHING, ["/usr/bin/podman", "push", Tag, '{Project:Destination}/{Tag}'])
	end
end

meth :build_from(Project: project, State: project::state) do
	if Project:State % 3 = 1 then
		Project:Next := :build_from(_, State)
	elseif Project:State >= State then
		Project:State := project::state(State - 2)
	end
	Project:build
end

let Server := soup::Server()

let LoginStmt := DB:statement("SELECT salt, passwd FROM users WHERE name = ?")

with AuthDomain := soup::AuthDomainBasic(realm is "racs") do
	AuthDomain:add_path("/project/create")
	AuthDomain:set_auth_callback(; AuthDomain, Message, Name, Password) do
		print('Name = {Name}, Password = {Password}\n')
		let Row := first(LoginStmt(Name))
		if Row then
			:> TODO: Actually check password
			ret true
		else
			print('Name: {Name} not found\n')
			ret false
		end
	on Error do
		print('Error: {Error:message}\n')
		ret false
	end
	Server:add_auth_domain(AuthDomain)
end

with AuthDomain := soup::AuthDomainBasic(realm is "racs") do
	AuthDomain:add_path("/logout")
	AuthDomain:set_auth_callback(; AuthDomain, Message, Name, Password) do
		ret false
	end
	Server:add_auth_domain(AuthDomain)
end

Server:listen_all(8081, nil)
log::info("Server running on http://localhost:8081")

Server:add_handler("/"; Server, Message, Path, Query, Client) do
	Message:set_response("text/plain", soup::MemoryUse::static, "Hello world")
	Message:set_status(200)
on Error do
	log::error(Error)
end

def MimeTypes := {
	"xhtml" is "application/xhtml+xml",
	"js" is "text/javascript",
	"css" is "text/css",
	"ico" is "image/png"
}

let serve_static_content := for Arg in Args do
	until Arg = "--cache-static", fun(Message, Path, MimeType) do
		log::info('Serving {Path} as {MimeType} with cache')
		let Content := :({})[Path; Path] do
			log::info('Reading {Path} into cache')
			let Channel := glib::IOChannel::new_file(Path, "r")
			Channel:set_encoding(nil)
			let (_, Content, Length) := Channel:read_to_end
			Channel:close
			Content
		end
		Message:set_response(MimeType, soup::MemoryUse::static, Content)
		Message:set_status(200)	
	on Error do
		log::error(Error)
		Message:set_status(404)
	end
else
	fun(Message, Path, MimeType) do
		log::info('Serving {Path} as {MimeType} without cache')
		let Channel := glib::IOChannel::new_file(Path, "r")
		Channel:set_encoding(nil)
		let (_, Content, Length) := Channel:read_to_end
		Channel:close
		Message:set_response(MimeType, soup::MemoryUse::static, Content)
		Message:set_status(200)	
	on Error do
		log::error(Error)
		Message:set_status(404)
	end
end

def StaticPath := glib::canonicalize_filename("static", nil)

Server:add_handler("/"; Server, Message, Path, Query, Client) do
	if Path = "/" then
		ret serve_static_content(Message, StaticPath + "/index.xhtml", "application/xhtml+xml")
	else
		let (_, Extension) := Path */ "."
		let MimeType := MimeTypes[Extension]
		if MimeType then
			let FullPath := glib::canonicalize_filename('{StaticPath}/{Path}', nil)
			if FullPath:starts(StaticPath) then
				ret serve_static_content(Message, FullPath, MimeType)
			end
		end
	end
	Message:set_status(404)
end

fun get_params(Query, Message) do
	if Query then ret Query end
	let Headers := Message::"request-headers"
	let ContentType := Headers:get_one("content-type"):lower
	if ContentType:starts("application/json") then
		ret json::decode(Message::"request-body-data":get_data[1])
	elseif ContentType:starts("multipart/form-data") then
		let Params := {}
		let Multipart := soup::Multipart::new_from_message(Message::"request-headers", Message::"request-body")
		for I in 0 .. (Multipart:get_length - 1) do
			let (_, Headers, Body) := Multipart:get_part(I)
			let Disposition := soup::header_parse_semi_param_list(Headers:get_one("content-disposition"):lower)
			Params[Disposition["name"]] := Body:get_data[2]
		end
		ret Params
	else
		error("TypeError", 'Unsupported content type: {ContentType}')
	end
end

Server:add_handler("/project/list"; Server, Message, Path, Query, Client) do
	let User := Client:get_auth_user
	log::info('Project List: User = {User}')
	Message:set_status(200)
	Message:set_response("application/json", soup::MemoryUse::static, json::encode(list(Projects; Project) {
		"id" is Project:Id,
		"name" is Project:Name,
		"state" is string(Project:State),
		"tasks" is list(Project:Tasks; Task) {
			"id" is Task:Id,
			"type" is Task:Type,
			"state" is string(Task:State)
		},
		"version" is Project:Version
	}))
on Error do
	log::error(Error)
	Message:set_status(500)
end

Server:add_handler("/project/status"; Server, Message, Path, Query, Client) do
	let User := Client:get_auth_user
	let Params := get_params(Query, Message)
	let Id := integer(Params["id"] or error("ParamError", "Missing parameter id"))
	let Project := Projects[Id] or error("ParamError", "Invalid project")
	Message:set_status(200)
	Message:set_response("application/json", soup::MemoryUse::static, json::encode({
		"state" is string(Project:State),
		"tasks" is list(Project:Tasks; Task) {
			"id" is Task:Id,
			"type" is Task:Type,
			"state" is string(Task:State)
		},
		"version" is Project:Version
	}))
on Error do
	log::error(Error)
	Message:set_status(500)
end

Server:add_handler("/project/create"; Server, Message, Path, Query, Client) do
	let User := Client:get_auth_user
	let Params := get_params(Query, Message)
	let Name := Params["name"] or error("ParamError", "Missing parameter name")
	let URL := Params["url"] or error("ParamError", "Missing parameter url")
	let Branch := Params["branch"] or error("ParamError", "Missing parameter branch")
	let Destination := Params["destination"] or error("ParamError", "Missing parameter destination")
	let Tag := Params["tag"] or error("ParamError", "Missing parameter tag")
	let Project := project_create(Name, URL, Branch, Destination, Tag)
	Message:set_redirect(303, '/project/status?id={Project:Id}')
on Error do
	log::error(Error)
	Message:set_status(500)
end

Server:add_handler("/project/upload"; Server, Message, Path, Query, Client) do
	let User := Client:get_auth_user
	let Params := get_params(Query, Message)
	let Id := integer(Params["id"] or error("ParamError", "Missing parameter id"))
	let Name := Params["name"] or error("ParamError", "Missing parameter name")
	let File := Params["file"] or error("ParamError", "Missing parameter file")
	let Project := Projects[Id] or error("ParamError", "Invalid project")
	let UploadPath := '{ProjectPath}/{Id}'
	let FullPath := glib::canonicalize_filename(Name, UploadPath)
	FullPath:starts(UploadPath) or error("PathError", "Invalid path")
	with Channel := glib::IOChannel::new_file(FullPath, "w") do
		Channel:set_encoding(nil)
		Channel:write_chars(File, File:length)
		Channel:shutdown(true)
	end
	Message:set_redirect(303, '/project/status?id={Id}')
on Error do
	log::error(Error)
	Message:set_status(500)
end

Server:add_handler("/project/build"; Server, Message, Path, Query, Client) do
	let User := Client:get_auth_user
	let Params := get_params(Query, Message)
	let Id := integer(Params["id"] or error("ParamError", "Missing parameter id"))
	let Stage := Params["stage"] or error("ParamError", "Missing parameter stage")
	let Project := Projects[Id] or error("ParamError", "Invalid project")
	when Stage
	is "clean" do Project:build_from(project::state::CLEANING)
	is "prepare" do Project:build_from(project::state::PREPARING)
	is "pull" do Project:build_from(project::state::PULLING)
	is "build" do Project:build_from(project::state::BUILDING)
	is "package" do Project:build_from(project::state::PACKAGING)
	else error("ParamError", "Invalid stage")
	end
	Message:set_redirect(303, '/project/status?id={Id}')
on Error do
	log::error(Error)
	Message:set_status(500)
end

Server:add_handler("/task/logs"; Server, Message, Path, Query, Client) do
	let User := Client:get_auth_user
	let Params := get_params(Query, Message)
	let Id := integer(Params["id"] or error("ParamError", "Missing parameter id"))
	let Offset := integer(Params["offset"] or error("ParamError", "Missing parameter offset"))
	let Channel := glib::IOChannel::new_file('tasks/{Id}/out.log', "r")
	Channel:set_encoding(nil)
	Channel:seek_position(Offset, glib::SeekType::set)
	let (_, Content, Length) := Channel:read_to_end
	Channel:close
	Message:set_response("text/plain", soup::MemoryUse::static, Content)
	Message:set_status(200)
on Error do
	log::error(Error)
	Message:set_status(500)
end

Loop:run