extra/bitcoin/client/client.factor

   1 ! Copyright (C) 2010 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   4 ! bitcoin API documentation at:
   5 !  http://www.bitcoin.org/wiki/doku.php?id=api
   6 !
   7 ! Donations can be sent to the following bitcoin address:
   8 ! 1HVMkUcaPhCeCK3rrBm31EY2bf5r33VHsj
   9 !
  10 USING:
  11     accessors
  12     assocs
  13     base64
  14     byte-arrays
  15     hashtables
  16     http
  17     http.client
  18     io.encodings.binary
  19     json.reader
  20     json.writer
  21     kernel
  22     locals
  23     namespaces
  24     sequences
  25     strings
  26     urls
  27 ;
  28 IN: bitcoin.client
  29
  30 : bitcoin-server ( -- string )
  31     \ bitcoin-server get "localhost" or ;
  32
  33 : bitcoin-port ( -- n )
  34     \ bitcoin-port get 8332 or ;
  35
  36 : bitcoin-user ( -- string )
  37     \ bitcoin-user get "" or ;
  38
  39 : bitcoin-password ( -- string )
  40     \ bitcoin-password get ;
  41
  42 <PRIVATE
  43
  44 : bitcoin-url ( -- url )
  45     <url>
  46       "http" >>protocol
  47       "/" >>path
  48       bitcoin-server >>host
  49       bitcoin-port >>port ;
  50
  51 :: payload ( method params -- data )
  52     "text/plain" <post-data>
  53         binary >>content-encoding
  54         H{
  55             { "method" method }
  56             { "params" params }
  57         } clone >json >byte-array >>data ;
  58
  59 : basic-auth ( -- string )
  60     bitcoin-user bitcoin-password ":" glue >base64 >string
  61     "Basic " prepend ;
  62
  63 : bitcoin-request ( method params -- request )
  64     payload bitcoin-url <post-request>
  65     basic-auth "Authorization" set-header
  66     dup post-data>> data>> length "Content-Length" set-header
  67     http-request nip >string json> "result" of ;
  68
  69 PRIVATE>
  70
  71 :: get-addresses-by-label ( label -- seq )
  72     "getaddressesbylabel" { label } bitcoin-request ;
  73
  74 : get-balance ( -- n )
  75     "getbalance" { } bitcoin-request ;
  76
  77 : get-block-count ( -- n )
  78     "getblockcount" { } bitcoin-request ;
  79
  80 : get-block-number ( -- n )
  81     "getblocknumber" { } bitcoin-request ;
  82
  83 : get-connection-count ( -- n )
  84     "getconnectioncount" { } bitcoin-request ;
  85
  86 : get-difficulty ( -- n )
  87     "getdifficulty" { } bitcoin-request ;
  88
  89 : get-generate ( -- ? )
  90     "getgenerate" { } bitcoin-request ;
  91
  92 :: set-generate ( gen n -- )
  93     "setgenerate" { gen n } bitcoin-request  drop ;
  94
  95 : get-info ( -- result )
  96     "getinfo" { } bitcoin-request ;
  97
  98 :: get-label ( address -- label )
  99     "getlabel" { address } bitcoin-request ;
 100
 101 :: set-label ( address label -- )
 102     "setlabel" { address  label } bitcoin-request  drop ;
 103
 104 :: remove-label ( address -- )
 105     "setlabel" { address } bitcoin-request  drop ;
 106
 107 : get-new-address ( -- address )
 108     "getnewaddress" { } bitcoin-request ;
 109
 110 :: get-new-labelled-address ( label -- address )
 111     "getnewaddress" { label } bitcoin-request ;
 112
 113 :: get-received-by-address ( address -- amount )
 114     "getreceivedbyaddress" { address } bitcoin-request ;
 115
 116 :: get-confirmed-received-by-address ( address minconf -- amount )
 117     "getreceivedbyaddress" { address minconf } bitcoin-request ;
 118
 119 :: get-received-by-label ( label -- amount )
 120     "getreceivedbylabel" { label } bitcoin-request ;
 121
 122 :: get-confirmed-received-by-label ( label minconf -- amount )
 123     "getreceivedbylabel" { label minconf } bitcoin-request ;
 124
 125 :: list-received-by-address ( minconf include-empty -- seq )
 126     "listreceivedbyaddress" { minconf include-empty } bitcoin-request ;
 127
 128 :: list-received-by-label ( minconf include-empty -- seq )
 129     "listreceivedbylabel" { minconf include-empty } bitcoin-request ;
 130
 131 :: send-to-address ( address amount -- ? )
 132     "sendtoaddress" { address amount } bitcoin-request "sent" = ;
 133
 134 : stop ( -- )
 135     "stop" { } bitcoin-request drop ;
 136
 137 #! requires patched bitcoind
 138 :: list-transactions ( count include-generated -- seq )
 139     "listtransactions" { count include-generated } bitcoin-request ;