add more core database tables

Makefile

@@ -15,7 +15,7 @@
 # You should have received a copy of the GNU Affero General Public License
 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
-.PHONY: all check clean monocypher
+.PHONY: all check clean monocypher dev-migrate dev-rollback
 
 all:
 	raco setup ./crossfire/
@@ -31,3 +31,9 @@ monocypher: lib/monocypher.so
 lib/monocypher.so: /usr/include/monocypher/monocypher.c /usr/include/monocypher/monocypher-ed25519.c
 	[ -d lib ] || mkdir lib
 	$(CC) -o $@ -O3 -pipe -shared $^
+
+dev-migrate:
+	raco north migrate -p crossfire/migrations -f
+
+dev-rollback:
+	raco north rollback -p crossfire/migrations -f

crossfire/comms.rkt

@@ -498,10 +498,10 @@
 ;; utility functions and macros for defining rpcs
 
 ;; id generation helpers
-(define-for-syntax (rpc-type-id what)
+(define-for-syntax (rpc-type-id type)
-  (format-id what "rpc-type-~a" (syntax-e what)))
+  (format-id type "rpc-type-~a" (syntax-e type)))
-(define-for-syntax (rpc-impl-id what)
+(define-for-syntax (rpc-impl-id type name)
-  (format-id what "rpc-impl-~a" (syntax-e what)))
+  (format-id type "rpc-impl-~a-~a" (syntax-e type) (syntax-e name)))
 
 ;; parameters for comms, tm, and targeted node
 (define current-comms (make-parameter #f))
@@ -518,13 +518,17 @@
 ;; call it
 (define-simple-macro (define-rpc type:id (name:id args:id ...) body:expr ...)
   #:with def-id (rpc-type-id #'type)
-  #:with impl-id (rpc-impl-id #'name)
+  #:with impl-id (rpc-impl-id #'type #'name)
   (begin
     (define (impl-id args ...) body ...)
     (define (name args ...)
       (tm-transact (current-tm) (node-id (current-to-node)) (quote name) (list args ...)))
     (hash-set! def-id (quote name) impl-id)))
 
+(define-simple-macro (rpc-impl type:id name:id)
+  #:with impl-id (rpc-impl-id #'type #'name)
+  impl-id)
+
 ;; installs all rpcs of a given rpc class into the transaction manager
 (define-simple-macro (install-rpc-type type:id)
   #:with def-id (rpc-type-id #'type)
@@ -532,7 +536,7 @@
     (tm-register-rpc (current-tm) k v)))
 
 (provide current-comms current-tm current-to-node current-from-node
-         define-rpc-type define-rpc install-rpc-type)
+         define-rpc-type define-rpc rpc-impl install-rpc-type)
 
 ; ;; demo code
 ; (define server-sk #"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")

crossfire/migrations/20201113-add-initial-tables.sql

@@ -1,19 +1,55 @@
 #lang north
 
 -- @revision: e50ab485d8590ead53c2518396c04f81
--- @description: Creates the tasks table.
+-- @description: Creates some initial core tables for crossfire.
 -- @up {
-create table tasks (id integer primary key, name text not null, manifest blob not null);
+PRAGMA foreign_keys = ON;
 -- }
 -- @up {
-create table nodes (id integer primary key, name text not null,
+create table node(id integer primary key, name text not null,
-                    type text check(type in ("client", "agent")) not null,
+                  type text check(type in ("client", "agent")) not null,
-                    secret blob(32) not null)
+                  secret blob(32) not null)
+-- }
+-- @up {
+create table resource(id integer primary key, name text not null);
+-- }
+-- @up {
+create table node_resource(nodeid integer not null, resid integer not null,
+                           unique (nodeid, resid),
+                           foreign key(resid) references resources(id),
+                           foreign key(nodeid) references nodes(id));
+-- }
+-- @up {
+create table task(id integer primary key, name text not null, manifest blob not null);
+-- }
+-- @up {
+create table task_log(taskid integer not null, worker integer not null,
+                      time_start timestamp not null,
+                      time_end timestamp check(time_end >= time_start) not null,
+                      pattern blob not null,
+                      foreign key (taskid) references tasks(id),
+                      foreign key (worker) references nodes(id));
+-- }
+-- @up {
+create table task_match(taskid integer not null, time timestamp not null, match blob not null,
+                        foreign key (taskid) references tasks(id));
 -- }
 
 -- @down {
-drop table nodes;
+drop table task_match;
 -- }
 -- @down {
-drop table tasks;
+drop table task_log;
+-- }
+-- @down {
+drop table task;
+-- }
+-- @down {
+drop table node_resource;
+-- }
+-- @down {
+drop table resource;
+-- }
+-- @down {
+drop table node;
 -- }

crossfire/protocol.rkt

@@ -16,7 +16,7 @@
 ;; You should have received a copy of the GNU Affero General Public License
 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
-(require db/base db/sqlite3 racket/match racket/runtime-path racket/path
+(require db/base db/sqlite3 racket/bool racket/match racket/runtime-path racket/path
          north/base north/adapter/base north/adapter/sqlite
          "comms.rkt" "not-crypto.rkt")
 
@@ -56,8 +56,8 @@
 (define-syntax-rule (define-stmt name what)
   (define name (virtual-statement what)))
 
-(define-stmt query-new-node "insert into nodes (name, type, secret) values (?, ?, ?)")
+(define-stmt q-new-node "insert into node (name, type, secret) values (?, ?, ?)")
-(define-stmt query-get-nodes "select id, name from nodes where type=?")
+(define-stmt q-get-nodes "select id, name from node where type=?")
 
 ;; rpc calls
 
@@ -66,10 +66,17 @@
 (struct node-info [id name online?] #:transparent)
 
 (define (get-nodes type)
-  (for/list ([(id name) (in-query (current-db) query-get-nodes (symbol->string type))])
+  (for/list ([(id name) (in-query (current-db) q-get-nodes (symbol->string type))])
     (define online? (comms-channel-available? (current-comms) id))
     (node-info id name online?)))
 
+(define (make-agent name)
+  (define secret (crypto-sign-make-key))
+  (define public (crypto-sign-public-key secret))
+  (define info (simple-result-info (query (current-db) q-new-node name "agent" secret)))
+  (define id (cdr (assoc 'insert-id info)))
+  (values id public))
+
 (define (enforce type)
   (unless (symbol=? type (node-type (current-from-node)))
     (error "unauthorized")))
@@ -82,10 +89,7 @@
 
 (define-rpc server (new-agent name)
   (enforce 'client)
-  (define secret (crypto-sign-make-key))
+  (define-values [id public] (make-agent name))
-  (define public (crypto-sign-public-key secret))
-  (define info (simple-result-info (query (current-db) query-new-node name 'agent secret)))
-  (define id (cdr (assoc 'insert-id info)))
   (define comms-node (node id name 'agent public #f #f #f))
   (comms-set-node-info (current-comms) comms-node)
   id)
@@ -100,3 +104,10 @@
 (define-rpc server (agent-report something)
   (enforce 'agent)
   (error "TODO"))
+
+
+;; command line usage
+(module+ main
+  (require racket/cmdline)
+  (current-db (open-server-db))
+  (make-agent "meow"))