(module bitcoin

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

(import scheme chicken ports data-structures)
(use medea uri-common http-client)

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