(defmodule nemoptera_sync
(behaviour gen_server)
(export all))
(defun tick-ms () 60000)
(defun local-refresh-ms () 600000)
(defun start_link ()
(gen_server:start_link #(local nemoptera_sync) 'nemoptera_sync 'none '()))
(defun init (_)
(erlang:send_after 5000 (self) 'tick)
`#(ok ,(maps:from_list (list (tuple 'last_local 0)))))
(defun handle_info (message state)
(case message
('tick
(catch (run-due))
(let ((now (erlang:monotonic_time 'millisecond))
(last (maps:get 'last_local state 0)))
(let ((state2 (if (>= (- now last) (local-refresh-ms))
(progn (catch (refresh-local))
(maps:put 'last_local now state))
state)))
(erlang:send_after (tick-ms) (self) 'tick)
`#(noreply ,state2))))
(_ `#(noreply ,state))))
(defun handle_call (_message _from state) `#(reply ok ,state))
(defun handle_cast (_message state) `#(noreply ,state))
(defun terminate (_reason _state) 'ok)
(defun code_change (_old state _extra) `#(ok ,state))
(defun run-due ()
(case (nemoptera_setup:installed?)
('false 'ok)
('true
(case (nemoptera_db:q
"SELECT id FROM repositories WHERE source='remote' AND sync_interval_minutes>0 AND (last_synced_at IS NULL OR datetime(last_synced_at)<=datetime('now', '-' || sync_interval_minutes || ' minutes'));"
'())
(rows (when (is_list rows))
(lists:foreach
(lambda (row)
(case row
(`(,id) (spawn (lambda () (catch (run-sync id)))))
(_ 'ok)))
rows))
(_ 'ok)))))
(defun refresh-local ()
(case (nemoptera_setup:installed?)
('false 'ok)
('true
(case (nemoptera_db:q "SELECT id FROM repositories;" '())
(rows (when (is_list rows))
(lists:foreach
(lambda (row)
(case row
(`(,id) (catch (refresh-timeline id 'false)))
(_ 'ok)))
rows))
(_ 'ok)))))
(defun run-sync (id)
(case (nemoptera_repo:fetch id)
(`#(ok ,repo)
(if (=:= (maps:get 'source repo) "remote")
(if (syncing? id)
`#(error "A sync is already running.")
(sync-now repo))
`#(error "This repository has no remote.")))
(error error)))
(defun sync-now (repo)
(let* ((id (maps:get 'id repo))
(log-id (open-log "sync_log" id)))
(case (nemoptera_fossil_repo:sync (maps:get 'remote_url repo) (maps:get 'fossil_path repo))
(`#(ok ,out)
(close-log "sync_log" log-id "ok" out)
(nemoptera_db:q "UPDATE repositories SET last_synced_at=?, last_sync_status=? WHERE id=?;"
(list (nemoptera_text:now-iso) "ok" id))
(refresh-timeline id 'true)
'ok)
(`#(error ,reason)
(let ((message (nemoptera_fossil:error-message reason)))
(close-log "sync_log" log-id "failed" message)
(nemoptera_db:q "UPDATE repositories SET last_synced_at=?, last_sync_status=? WHERE id=?;"
(list (nemoptera_text:now-iso) message id))
`#(error ,message))))))
(defun refresh-timeline (id push-after?)
(case (nemoptera_repo:fetch id)
(`#(ok ,repo)
(let ((old (maps:get 'timeline repo))
(stamp (nemoptera_fossil_repo:last-timeline (maps:get 'fossil_path repo))))
(nemoptera_db:q "UPDATE repositories SET last_timeline_at=? WHERE id=?;"
(list (if (=:= stamp "unknown") 'undefined stamp) id))
(if (and (or push-after? (not (=:= old stamp)))
(=:= (maps:get 'git_auto_push repo) 1)
(=:= (maps:get 'git_enabled repo) 1)
(not (=:= stamp "unknown"))
(not (=:= old stamp)))
(run-push id)
'ok)))
(_ 'ok)))
(defun run-push (id)
(case (nemoptera_repo:fetch id)
(`#(ok ,repo)
(cond
((/= (maps:get 'git_enabled repo) 1) `#(error "Git push is not enabled."))
((nemoptera_text:blank? (maps:get 'git_url repo)) `#(error "Git URL is required."))
('true (push-now repo))))
(error error)))
(defun push-now (repo)
(let* ((id (maps:get 'id repo))
(log-id (open-log "push_log" id)))
(case (nemoptera_crypto:open-sealed (maps:get 'git_token_enc repo))
(`#(ok ,token)
(case (nemoptera_fossil_git:export (maps:get 'fossil_path repo)
(maps:get 'git_url repo)
(maps:get 'git_username repo)
token)
(`#(ok ,out)
(close-log "push_log" log-id "ok" out)
(nemoptera_db:q "UPDATE repositories SET last_pushed_at=?, last_push_status=? WHERE id=?;"
(list (nemoptera_text:now-iso) "ok" id))
'ok)
(`#(error ,reason)
(let ((message (nemoptera_fossil:error-message reason)))
(close-log "push_log" log-id "failed" message)
(nemoptera_db:q "UPDATE repositories SET last_pushed_at=?, last_push_status=? WHERE id=?;"
(list (nemoptera_text:now-iso) message id))
`#(error ,message)))))
(_
(close-log "push_log" log-id "failed" "Stored Git credential could not be read.")
`#(error "Stored Git credential could not be read.")))))
(defun syncing? (id)
(case (nemoptera_db:q "SELECT id FROM sync_log WHERE repository_id=? AND finished_at IS NULL;" (list id))
(`((,_)) 'true)
(_ 'false)))
(defun open-log (table id)
(nemoptera_db:q
(lists:flatten (list "INSERT INTO " table "(repository_id,started_at,status,message) VALUES(?,?,?,?);"))
(list id (nemoptera_text:now-iso) "running" ""))
(nemoptera_db:insert-id))
(defun close-log (table log-id status message)
(nemoptera_db:q
(lists:flatten (list "UPDATE " table " SET finished_at=?, status=?, message=? WHERE id=?;"))
(list (nemoptera_text:now-iso) status (nemoptera_text:clip message 2000) log-id)))