;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; An interface to bitcoind's JSON-RPC API for CHICKEN Scheme.
;;;
;;; This software is written by Evan Hanson <evhan@foldling.org> and
;;; placed in the Public Domain. All warranties are disclaimed.
;;;

(require-library medea uri-common http-client)

(module bitcoin ()
  (import scheme chicken ports data-structures)
  (import medea uri-common http-client)
  (export make-bitcoind-connection
          bitcoind-connection-uri
          bitcoind-connection?
          bitcoind-request)

(define-record bitcoind-connection uri)

(define make-bitcoind-connection
  (let ((make-bitcoind-connection make-bitcoind-connection))
    (lambda (uri)
      (make-bitcoind-connection
       (if (uri-reference? uri)
           uri
           (uri-reference uri))))))

(define (bitcoin-error condition method arguments)
  (signal
   (make-composite-condition
    (make-property-condition 'bitcoin)
    (make-property-condition 'exn
     'location method
     'arguments arguments
     'message (bitcoind-server-error-message condition)))))

(define bitcoind-server-error-message
  (let ((cpa (condition-property-accessor 'server-error 'body)))
    (lambda (exn)
      (alist-ref 'message (alist-ref 'error (with-input-from-string (cpa exn) read-json))))))

(define (bitcoind-request connection method . params)
  (condition-case
    (with-input-from-request
     (bitcoind-connection-uri connection)
     (with-output-to-string
      (lambda ()
        (write-json
         `((jsonrpc . "1.0")
           (method  . ,(symbol->string method))
           (params  . ,(list->vector params))))))
     (lambda ()
       (alist-ref 'result (read-json))))
    (condition (exn http server-error)
     (bitcoin-error condition method params)))))