extra/bitcoin/client/client.factor

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