Source

chicken-bitcoin / bitcoin.scm

Full commit
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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
          ;; API calls
          addmultisigaddress
          backupwallet
          createrawtransaction
          decoderawtransaction
          dumpprivkey
          encryptwallet
          getaccount
          getaccountaddress
          getaddressesbyaccount
          getbalance
          getblock
          getblockcount
          getblockhash
          getblocknumber
          getconnectioncount
          getdifficulty
          getgenerate
          gethashespersec
          getinfo
          getmemorypool
          getmininginfo
          getnewaddress
          getpeerinfo
          getrawmempool
          getrawtransaction
          getreceivedbyaccount
          getreceivedbyaddress
          gettransaction
          getwork
          help
          importprivkey
          keypoolrefill
          listaccounts
          listreceivedbyaccount
          listreceivedbyaddress
          listsinceblock
          listtransactions
          listunspent
          move
          sendfrom
          sendmany
          sendrawtransaction
          sendtoaddress
          setaccount
          setgenerate
          signmessage
          signrawtransaction
          settxfee
          stop
          validateaddress
          verifymessage
          walletlock
          walletpassphrase
          walletpassphrasechange)

(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))))

(define-syntax define-api-call
  (syntax-rules ()
    ((_ <name>)
     (define (<name> connection . params)
       (call-with-values
        (lambda () (apply bitcoind-request connection '<name> params))
        (lambda (result uri response) result))))))

(define-api-call addmultisigaddress)
(define-api-call backupwallet)
(define-api-call createrawtransaction)
(define-api-call decoderawtransaction)
(define-api-call dumpprivkey)
(define-api-call encryptwallet)
(define-api-call getaccount)
(define-api-call getaccountaddress)
(define-api-call getaddressesbyaccount)
(define-api-call getbalance)
(define-api-call getblock)
(define-api-call getblockcount)
(define-api-call getblockhash)
(define-api-call getblocknumber)
(define-api-call getconnectioncount)
(define-api-call getdifficulty)
(define-api-call getgenerate)
(define-api-call gethashespersec)
(define-api-call getinfo)
(define-api-call getmemorypool)
(define-api-call getmininginfo)
(define-api-call getnewaddress)
(define-api-call getpeerinfo)
(define-api-call getrawmempool)
(define-api-call getrawtransaction)
(define-api-call getreceivedbyaccount)
(define-api-call getreceivedbyaddress)
(define-api-call gettransaction)
(define-api-call getwork)
(define-api-call help)
(define-api-call importprivkey)
(define-api-call keypoolrefill)
(define-api-call listaccounts)
(define-api-call listreceivedbyaccount)
(define-api-call listreceivedbyaddress)
(define-api-call listsinceblock)
(define-api-call listtransactions)
(define-api-call listunspent)
(define-api-call move)
(define-api-call sendfrom)
(define-api-call sendmany)
(define-api-call sendrawtransaction)
(define-api-call sendtoaddress)
(define-api-call setaccount)
(define-api-call setgenerate)
(define-api-call signmessage)
(define-api-call signrawtransaction)
(define-api-call settxfee)
(define-api-call stop)
(define-api-call validateaddress)
(define-api-call verifymessage)
(define-api-call walletlock)
(define-api-call walletpassphrase)
(define-api-call walletpassphrasechange))