|
30 | 30 | ;;; Imports
|
31 | 31 |
|
32 | 32 | (import
|
| 33 | + (for-syntax :std/srfi/13) |
33 | 34 | (group-in :std format iter sort sugar values)
|
34 | 35 | (group-in :std/cli getopt multicall)
|
35 |
| - (group-in :std/misc hash path number) |
| 36 | + (group-in :std/misc hash list path number) |
36 | 37 | (group-in :std/net httpd request uri)
|
37 | 38 | (only-in :std/net/address inet-address->string)
|
38 | 39 | (group-in :std/srfi |1|)
|
|
267 | 268 | oracle (json-object->string path) (json-object->string data))
|
268 | 269 | #f))))
|
269 | 270 |
|
| 271 | +;;; Basic HTTP handlers |
| 272 | + |
| 273 | +;; / -- handler for the main page |
| 274 | +(def (root-handler req res) |
| 275 | + (http-response-write |
| 276 | + res 200 '(("Content-Type" . "text/html")) |
| 277 | + (with-output-to-string [] |
| 278 | + (cut write-xml |
| 279 | + `(html |
| 280 | + (head |
| 281 | + (meta (@ (http-equiv "Content-Type") (content "text/html; charset=utf-8"))) |
| 282 | + (title "Sequentia Rates Server") |
| 283 | + (body |
| 284 | + (h1 "Hello, " ,(inet-address->string (http-request-client req))) |
| 285 | + (p "Welcome to this " |
| 286 | + (a (@ (href "https://sequentia.io")) "Sequentia") |
| 287 | + " rates server. " |
| 288 | + "Please use " |
| 289 | + (a (@ (href "/rates")) "our JSON-RPC interface") ".")))))))) |
| 290 | + |
| 291 | +(def (default-handler req res) ; default -- 404 |
| 292 | + (http-response-write res 404 '(("Content-Type" . "text/plain")) "Page not found.")) |
| 293 | + |
| 294 | +(def handlers [["/" root-handler]]) |
| 295 | + |
| 296 | + |
| 297 | +;;; Infrastructure for JSON getter functions: |
| 298 | +;;; defining and registering getter, HTTP handler, CLI entry-point. |
| 299 | + |
| 300 | +(def rates-mutex (make-mutex "rates")) |
| 301 | + |
| 302 | +(defrule (define-json-getter (getter assets-config services-config) body ...) |
| 303 | + (with-id define-json-getter |
| 304 | + ((handler #'getter '-handler) |
| 305 | + (entry-point (string-filter (lambda (x) (not (eqv? x #\-))) (as-string (syntax->datum #'getter))))) |
| 306 | + (def (getter |
| 307 | + assets-config: (assets-config (rates-assets-config)) |
| 308 | + services-config: (services-config (rates-services-config))) |
| 309 | + body ...) |
| 310 | + (def (handler req res) |
| 311 | + (with-lock |
| 312 | + rates-mutex |
| 313 | + (cut http-response-write |
| 314 | + res 200 '(("Content-Type" . "application/json-rpc")) |
| 315 | + (json-object->string (getter))))) |
| 316 | + (define-entry-point (entry-point) |
| 317 | + (help: (as-string "Pretty print " 'entry-point " data") getopt: []) |
| 318 | + (rates-environment) |
| 319 | + (pj (getter))) |
| 320 | + (push! [(as-string "/" 'entry-point) handler] handlers))) |
| 321 | + |
| 322 | + |
| 323 | +;;; Actual JSON getter functions |
| 324 | + |
270 | 325 | ;; Given assets-config and services-config, and using the cache,
|
271 | 326 | ;; return a table that to each currency code (string) associates a table from service name (string)
|
272 | 327 | ;; to conversion rate (Real) from the currency to RFU (aka USD).
|
273 | 328 | ;; (Table (Table Real <- String) <- String) <- assets-config: ?JSON services-config: ?JSON
|
274 |
| -(def (get-rates |
275 |
| - assets-config: (assets-config (rates-assets-config)) |
276 |
| - services-config: (services-config (rates-services-config))) |
| 329 | +(define-json-getter (get-rates assets-config services-config) |
277 | 330 | (hash-value-map
|
278 | 331 | assets-config
|
279 | 332 | (lambda (asset)
|
|
282 | 335 | (cons oracle (get-rate/oracle-path oracle path services-config: services-config)))
|
283 | 336 | (hash-ref asset "oracles")))))
|
284 | 337 |
|
| 338 | + |
285 | 339 | ;; Get the median rate among those available in a table, or #f if no rates are available.
|
286 | 340 | ;; Real <- (Table Real <- String)
|
287 | 341 | (def (median<-rates rates)
|
288 | 342 | (median (filter identity (hash-values rates)) #f))
|
289 | 343 |
|
| 344 | +;; Get the median rates from all the rates |
| 345 | +(def (median-rates<-all-rates rates) |
| 346 | + (hash-value-map rates median<-rates)) |
| 347 | + |
290 | 348 | ;; Get the median rates for the configured currencies
|
291 | 349 | ;; (Table Real <- String) <- assets-config: ?JSON services-config: ?JSON
|
292 | 350 | (def (get-median-rates
|
293 | 351 | assets-config: (assets-config (rates-assets-config))
|
294 | 352 | services-config: (services-config (rates-services-config)))
|
295 |
| - (hash-value-map |
296 |
| - (get-rates assets-config: assets-config |
297 |
| - services-config: services-config) |
298 |
| - median<-rates)) |
| 353 | + (median-rates<-all-rates |
| 354 | + (get-rates assets-config: assets-config services-config: services-config))) |
299 | 355 |
|
300 | 356 | (def (normalize-rate x)
|
301 | 357 | (integer-part (round x)))
|
|
305 | 361 | (def COIN-decimals 8)
|
306 | 362 | (def COIN (expt 10 COIN-decimals))
|
307 | 363 |
|
308 |
| -;; Return an associative array mapping nAsset (as hex string) to 1e8 times |
309 |
| -;; the value of one atom of the asset (minimal integer value, 1, as in 1 satoshi) |
310 |
| -;; in atom of the RFU (i.e. minimal integer value, 1) |
311 |
| -(def (get-fee-exchange-rates |
312 |
| - assets-config: (assets-config (rates-assets-config)) |
313 |
| - services-config: (services-config (rates-services-config))) |
314 |
| - (def rates (get-median-rates assets-config: assets-config |
315 |
| - services-config: services-config)) |
316 | 364 |
|
317 |
| - ;; How much is 1 atom (10^-decimals) of a |
| 365 | +(def (normalized-rates<-median-rates median-rates assets-config: assets-config) |
| 366 | + ;; How much is 1 atom (10^-decimals) of a RFU |
318 | 367 | (def (semi-rate asset (default #f))
|
319 | 368 | (def config (hash-ref assets-config asset (hash)))
|
320 |
| - (alet ((rate (hash-ref rates asset default))) |
| 369 | + (alet ((rate (hash-ref median-rates asset default))) |
321 | 370 | (* rate
|
322 | 371 | (hash-ref config "fudge_factor" 1)
|
323 | 372 | (expt 10 (- (hash-ref config "decimals" COIN-decimals))))))
|
|
332 | 381 | (normalize-rate (* COIN (/ asset-rate RFU-rate))))))
|
333 | 382 | h)
|
334 | 383 |
|
| 384 | + |
| 385 | +;; Return an associative array mapping nAsset (as hex string) to 1e8 times |
| 386 | +;; the value of one atom of the asset (minimal integer value, 1, as in 1 satoshi) |
| 387 | +;; in atom of the RFU (i.e. minimal integer value, 1) |
| 388 | +(define-json-getter (get-fee-exchange-rates assets-config services-config) |
| 389 | + (normalized-rates<-median-rates |
| 390 | + (get-median-rates assets-config: assets-config |
| 391 | + services-config: services-config) |
| 392 | + assets-config: assets-config)) |
| 393 | + |
| 394 | + |
| 395 | +(define-json-getter (get-assets assets-config services-config) |
| 396 | + (def all-rates (get-rates assets-config: assets-config |
| 397 | + services-config: services-config)) |
| 398 | + (def median-rates (median-rates<-all-rates all-rates)) |
| 399 | + (def normalized-rates (normalized-rates<-median-rates |
| 400 | + median-rates assets-config: assets-config)) |
| 401 | + (def h (hash)) |
| 402 | + (for (((values asset config) (in-hash assets-config))) |
| 403 | + (def (c x) (hash-get config x)) |
| 404 | + (alet (nAsset (c "nAsset")) |
| 405 | + (hash-put! h nAsset |
| 406 | + (hash |
| 407 | + ("ticker" asset) |
| 408 | + ("name" (c "name")) |
| 409 | + ("normalized_rate" (hash-get normalized-rates nAsset)) |
| 410 | + ("median_rate" (hash-get median-rates asset)) |
| 411 | + ("oracle_rates" (hash-get all-rates asset)))))) |
| 412 | + h) |
| 413 | + |
| 414 | + |
335 | 415 | ;;; The access methods
|
336 | 416 |
|
337 | 417 | ;; Macro to define a price oracle.
|
|
477 | 557 | ;;; TODO: Connecting to a sequentia node
|
478 | 558 |
|
479 | 559 |
|
480 |
| -;; /rates -- handler for the rates page |
481 |
| -(def rates-mutex (make-mutex "rates")) |
482 |
| -(def (rates-handler req res) |
483 |
| - (with-lock |
484 |
| - rates-mutex |
485 |
| - (cut http-response-write |
486 |
| - res 200 '(("Content-Type" . "application/json-rpc")) |
487 |
| - (json-object->string (get-rates))))) |
488 |
| - |
489 |
| -;; /getfeeexchangerates -- handler for the rates page |
490 |
| -(def (getfeeexchangerates-handler req res) |
491 |
| - (with-lock |
492 |
| - rates-mutex |
493 |
| - (cut http-response-write |
494 |
| - res 200 '(("Content-Type" . "application/json-rpc")) |
495 |
| - (json-object->string (get-fee-exchange-rates))))) |
496 |
| - |
497 |
| -;; / -- handler for the main page |
498 |
| -(def (root-handler req res) |
499 |
| - (http-response-write |
500 |
| - res 200 '(("Content-Type" . "text/html")) |
501 |
| - (with-output-to-string [] |
502 |
| - (cut write-xml |
503 |
| - `(html |
504 |
| - (head |
505 |
| - (meta (@ (http-equiv "Content-Type") (content "text/html; charset=utf-8"))) |
506 |
| - (title "Sequentia Rates Server") |
507 |
| - (body |
508 |
| - (h1 "Hello, " ,(inet-address->string (http-request-client req))) |
509 |
| - (p "Welcome to this " |
510 |
| - (a (@ (href "https://sequentia.io")) "Sequentia") |
511 |
| - " rates server. " |
512 |
| - "Please use " |
513 |
| - (a (@ (href "/rates")) "our JSON-RPC interface") ".")))))))) |
514 |
| - |
515 |
| -;; default -- 404 |
516 |
| -(def (default-handler req res) |
517 |
| - (http-response-write res 404 '(("Content-Type" . "text/plain")) "Page not found.")) |
518 |
| - |
519 |
| -(def handlers |
520 |
| - [["/" root-handler] |
521 |
| - ["/rates" rates-handler] |
522 |
| - ["/getfeeexchangerates" getfeeexchangerates-handler]]) |
523 |
| - |
524 | 560 | ;; 29256 comes from the last bytes of echo -n 'sequentia rates server' | sha256sum
|
525 |
| -(define-entry-point (server address: (address "127.0.0.1:29256")) |
| 561 | +(define-entry-point (server address: (address "0.0.0.0:29256")) |
526 | 562 | (help: "Start a server"
|
527 | 563 | getopt: [(option 'address "-a" "--address"
|
528 | 564 | help: "Address on which to start a server"
|
529 |
| - default: "127.0.0.1:29256")]) |
| 565 | + default: "0.0.0.0:29256")]) |
530 | 566 | (rates-environment)
|
531 | 567 | (displayln "Current rates are:")
|
532 | 568 | (pj (get-rates))
|
|
540 | 576 | ;; Wait for it to end
|
541 | 577 | (thread-join! httpd))
|
542 | 578 |
|
543 |
| -(define-entry-point (getrates) |
544 |
| - (help: "Pretty-print rates" |
545 |
| - getopt: []) |
546 |
| - (rates-environment) |
547 |
| - (pj (get-rates))) |
548 |
| - |
549 |
| -(define-entry-point (getfeeexchangerates) |
550 |
| - (help: "Pretty-print getfeeexchangerates data" |
551 |
| - getopt: []) |
552 |
| - (rates-environment) |
553 |
| - (pj (get-fee-exchange-rates))) |
554 |
| - |
555 | 579 | (set-default-entry-point! 'server)
|
556 | 580 | ;(dump-stack-trace? #f)
|
557 | 581 | (define-multicall-main)
|
0 commit comments