~pepe/hemple

hemple/hemple/init.janet -rw-r--r-- 6.0 KiB
248a8c6d — Josef Pospíšil WIP - small code fixes 7 months 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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
(import jhydro :as jh)
(import miniz :as z)
(use marble)
###
### 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 make-encoder [msg-id session-pair]
  (fn encoder [msg]
    (-> msg
        marshal
        z/compress
        (jh/secretbox/encrypt msg-id ctx (session-pair :tx)))))

(defn make-decoder [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
  with methods that clients can call. Under the :psk must be 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 (freeze (keys handler)))
  (def {:public-key pk :secret-key sk} (jh/kx/keygen))
  (def known-peers @{})

  (fn on-connection [connection]
    (defn handshake []
      (def hrecv (make-recv connection string))
      (def hsend (make-send connection string))
      (var packet1 (hrecv))
      (if-let [[peer-pk _] (known-peers packet1)]
        (do
          (set packet1 (hrecv))
          (def packet2 (buffer/new 48))
          (def ret [(jh/kx/kk2 packet2 packet1 peer-pk pk sk) peer-pk])
          (hsend packet2)
          ret)
        (do
          (def packet2 (buffer/new 96))
          (def state (jh/kx/xx2 packet2 packet1 psk pk sk))
          (hsend packet2)
          (def packet3 (hrecv))
          (def peer-pk (buffer/new 32))
          [(jh/kx/xx4 state packet3 psk peer-pk) peer-pk])))

    (match (protect (handshake))
      [false err]
      (do
        (ev/give-supervisor :close connection)
        (break))
      [true [session-pair peer-pk]]
      (do
        (var msg-id 0)
        (def recv (make-recv connection (make-decoder msg-id session-pair)))
        (def send (make-send connection (make-encoder msg-id session-pair)))
        (def peer-name (recv))
        (put known-peers peer-name [peer-pk (os/time)])
        (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))))))))

(def Client
  ```
  Prototype for the RPC client.
  TODO: document
  ```
  @{:open (fn open [self]
            (set (self :stream) (net/connect (self :host) (self :port)))
            (merge-into self (jh/kx/keygen))
            (match (protect (:handshake self))
              [true _] (:setup-connection self)
              [false err] (error err)))
    :close (fn close [self]
             (:close (self :stream))
             (set (self :stream) nil)
             self)
    :reopen
    (fn reopen [self]
      (set (self :stream) (net/connect (self :host) (self :port)))
      (def hrecv (make-recv (self :stream) string))
      (def hsend (make-send (self :stream) string))
      (hsend (self :name))
      (def packet1 (buffer/new 48))
      (def state (jh/kx/kk1 packet1 (self :peer-pk)
                            (self :public-key) (self :secret-key)))
      (hsend packet1)
      (def packet2 (hrecv))
      (set (self :session-pair)
           (jh/kx/kk3 state packet2 (self :public-key) (self :secret-key)))
      (:setup-connection self))
    :handshake
    (fn handshake [self]
      (def {:public-key pk :secret-key sk} self)
      (def hrecv (make-recv (self :stream) string))
      (def hsend (make-send (self :stream) string))
      (def packet1 (buffer/new 48))
      (def state (jh/kx/xx1 packet1 (self :psk)))
      (hsend packet1)
      (def packet2 (hrecv))
      (def packet3 (buffer/new 64))
      (def peer-pk (buffer/new 32))
      (set (self :session-pair)
           (jh/kx/xx3 state packet3 packet2 (self :psk) pk sk peer-pk))
      (set (self :peer-pk) peer-pk)
      (hsend packet3))
    :setup-connection
    (fn setup-connection [self]
      (var msg-id 0)
      (def recv
        (make-recv (self :stream) (make-decoder msg-id (self :session-pair))))
      (def send
        (make-send (self :stream) (make-encoder msg-id (self :session-pair))))
      (send (self :name))
      (def fnames (recv))
      (each f fnames
        (set (self (keyword f))
             (fn rpc-function [_ & args]
               (send [f args])
               (++ msg-id)
               (let [[ok x] (recv)]
                 (if ok x (error x))))))
      self)})

(defn client
  ```
  Create an RPC client. Returns a table of async functions
  that can be used to make remote calls. This prototype contains
  a `:close` and `:reopen` methods that can be used to close and
  reopen the connection respectively.
  ```
  [&opt host port name psk]

  (def client
    (make Client
          :host host
          :port port
          :psk psk
          :name name))
  (:open client))