add some server rpc defs

crossfire/comms.rkt

@@ -343,7 +343,8 @@
       (comms-connect comms to-id))
     (comms-dispatch-msg comms to-id msg)))
 
-(provide make-comms comms-listen comms-connect comms-get-node-info comms-set-node-info)
+(provide make-comms comms-listen comms-connect comms-get-node-info comms-set-node-info
+         comms-channel-available?)
 
 ;; transactional messages support
 
@@ -425,7 +426,9 @@
 
     (with-handlers ([exn? respond])
       (define arg-data (trans-data-deserialize rpc-data))
-      (define result (apply func arg-data))
+      (define result
+        (parameterize ([current-from-node (comms-get-node-info comms from-id)])
+          (apply func arg-data)))
       (displayln (list "result" result "sending back..."))
       (respond result)))
 
@@ -504,6 +507,7 @@
 (define current-comms (make-parameter #f))
 (define current-tm (make-parameter #f))
 (define current-to-node (make-parameter #f))
+(define current-from-node (make-parameter #f))
 
 ;; defines a class of rpcs
 (define-simple-macro (define-rpc-type type:id)
@@ -518,7 +522,7 @@
   (begin
     (define (impl-id args ...) body ...)
     (define (name args ...)
-      (tm-transact (current-tm) (current-to-node) (quote name) (list args ...)))
+      (tm-transact (current-tm) (node-id (current-to-node)) (quote name) (list args ...)))
     (hash-set! def-id (quote name) impl-id)))
 
 ;; installs all rpcs of a given rpc class into the transaction manager
@@ -527,7 +531,7 @@
   (for ([(k v) (in-hash def-id)])
     (tm-register-rpc (current-tm) k v)))
 
-(provide current-comms current-tm current-to-node
+(provide current-comms current-tm current-to-node current-from-node
          define-rpc-type define-rpc install-rpc-type)
 
 ; ;; demo code

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/path racket/runtime-path
+(require db/base db/sqlite3 racket/match racket/runtime-path racket/path
          north/base north/adapter/base north/adapter/sqlite
          "comms.rkt" "not-crypto.rkt")
 
@@ -53,21 +53,50 @@
     (adapter-apply! adapter (migration-revision migration) (migration-up migration)))
   (void))
 
-(migrate-server-db (open-server-db 'create))
+(define-syntax-rule (define-stmt name what)
-
+  (define name (virtual-statement what)))
-(define (with-server-db proc)
-  (parameterize ([current-db (open-server-db)])
-    (proc)
-    (disconnect (current-db))))
 
+(define-stmt query-new-node "insert into nodes (name, type, secret) values (?, ?, ?)")
+(define-stmt query-get-nodes "select id, name from nodes where type=?")
 
 ;; rpc calls
 
 (define-rpc-type server)
 
-(define-rpc server (test-rpc a b)
+(struct node-info [id name online?] #:transparent)
-  (displayln "test rpc")
-  (displayln b)
-  (add1 a))
 
+(define (get-nodes type)
+  (for/list ([(id name) (in-query (current-db) query-get-nodes (symbol->string type))])
+    (define online? (comms-channel-available? (current-comms) id))
+    (node-info id name online?)))
 
+(define (enforce type)
+  (unless (symbol=? type (node-type (current-from-node)))
+    (error "unauthorized")))
+
+;; client rpcs
+
+(define-rpc server (get-agents)
+  (enforce 'client)
+  (get-nodes 'agent))
+
+(define-rpc server (new-agent name)
+  (enforce 'client)
+  (define secret (crypto-sign-make-key))
+  (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)
+
+(define-rpc server (get-agent-deployment id)
+  (enforce 'client)
+  ;; bake secret key into binary and ship it i guess
+  (error "TODO"))
+
+;; agent rpcs
+
+(define-rpc server (agent-report something)
+  (enforce 'agent)
+  (error "TODO"))