~pepe/hemple

hemple/hemple/init.janet -rw-r--r-- 4.1 KiB
badb3d5fJosef Pospíšil Do not error on handshake 25 days ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
(import jhydro :as jh)
(import miniz :as z)
###
### hydrpc.janet
###
### Crypto RPC server and client tailored to Janet.
###
### Parts blatantly stolen from janet-lang/spork/rpc

### Limitations: ????
###
### Currently calls are resolved in the order that they are sent
### on the connection - in other words, a single RPC server must resolve
### remote calls sequentially. This means it is recommended to make multiple
### connections for separate transactions.

(use spork/msg)

(def ctx (dyn :neil-ctx "neilneil"))

(defn encode [msg-id session-pair]
  (fn encoder [msg]
    (-> msg
        marshal
        z/compress
        (jh/secretbox/encrypt msg-id ctx (session-pair :tx)))))

(defn decode [msg-id session-pair]
  (fn decoder [msg]
    (-> msg
        (jh/secretbox/decrypt msg-id ctx (session-pair :rx))
        z/decompress
        unmarshal)))

(defn default-supervisor
  ```
  Default supervisor.
  Param chan is the supervising channel of the server,
  handling is the handling function.
  ```
  [chan handling]
  (forever
    (match (ev/take chan)
      [:close connection] (:close connection)
      [:error fiber]
      (do
        (def err (fiber/last-value fiber))
        (def conn ((fiber/getenv fiber) :conn))
        (eprint err)
        (:close conn))
      [:conn connection]
      (ev/go
        (fiber/new
          (fn []
            (setdyn :conn connection)
            (handling connection)) :tp) nil chan))))

(defn on-connection
  ```
  Create a handler for the RPC server. It must take a dictionary of handler
  that clients can call. Host and port are not optional. Psk is the preshared
  key for the jhydro handler.
  This function can be used by the chidi/server.
  ```
  [handler]

  (def psk (handler :psk))
  (put handler :psk nil)
  (def keys-msg (keys handler))
  (def {:public-key pk :secret-key sk} (jh/kx/keygen))

  (fn [connection]
    (defn handshake []
      (def hrecv (make-recv connection string))
      (def hsend (make-send connection string))
      (def packet1 (hrecv))
      (def packet2 @"")
      (def state (jh/kx/xx2 packet2 packet1 psk pk sk))
      (hsend packet2)
      (def packet3 (hrecv))
      (jh/kx/xx4 state packet3 psk))

    (match (protect (handshake))
      [false err]
      (do
        (ev/give-supervisor :close connection)
        (break))
      [true session-pair]
      (do
        (var msg-id 0)
        (def recv (make-recv connection (decode msg-id session-pair)))
        (def send (make-send connection (encode msg-id session-pair)))
        (send keys-msg)
        (forever
          (match (protect (recv))
            [true (msg (not (nil? msg)))]
            (let [[fnname args] msg
                  f (handler fnname)]
              (++ msg-id)
              (if-not f
                (send [false (string "no function " fnname " supported")])
                (send (protect (f handler ;args)))))
            (do
              (ev/give-supervisor :close connection)
              (break))))))))

(defn client
  ```
  Create an RPC client. Returns a table of async functions
  that can be used to make remote calls. This table also contains
  a close function that can be used to close the connection.
  ```

  [&opt host port name psk]

  (def stream (net/connect host port))
  (var session-pair {})
  (def ret
    @{:close (fn [&] (:close stream))})

  (defn handshake []
    (def {:public-key pk :secret-key sk} (jh/kx/keygen))
    (def hrecv (make-recv stream string))
    (def hsend (make-send stream string))
    (def packet1 @"")
    (def state (jh/kx/xx1 packet1 psk))
    (hsend packet1)
    (def packet2 (hrecv))
    (def packet3 @"")
    (set session-pair (jh/kx/xx3 state packet3 packet2 psk pk sk))
    (hsend packet3))

  (defn setup-connection []
    (var msg-id 0)
    (def recv (make-recv stream (decode msg-id session-pair)))
    (def send (make-send stream (encode msg-id session-pair)))
    (def fnames (recv))
    (each f fnames
      (put ret (keyword f)
           (fn rpc-function [_ & args]
             (send [f args])
             (++ msg-id)
             (let [[ok x] (recv)]
               (if ok x (error x)))))))

  (match (protect (handshake))
    [true _] (setup-connection)
    [false err] (error err))

  ret)