| 
									
										
										
										
											2010-09-22 02:03:34 -04:00
										 |  |  | ! Copyright (C) 2010 Chris Double. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | !
 | 
					
						
							|  |  |  | ! bitcoin API documentation at: | 
					
						
							|  |  |  | !  http://www.bitcoin.org/wiki/doku.php?id=api | 
					
						
							|  |  |  | !
 | 
					
						
							|  |  |  | ! Donations can be sent to the following bitcoin address: | 
					
						
							|  |  |  | ! 1HVMkUcaPhCeCK3rrBm31EY2bf5r33VHsj | 
					
						
							|  |  |  | !
 | 
					
						
							|  |  |  | USING: | 
					
						
							|  |  |  |     accessors | 
					
						
							|  |  |  |     assocs | 
					
						
							|  |  |  |     base64 | 
					
						
							|  |  |  |     byte-arrays | 
					
						
							|  |  |  |     hashtables | 
					
						
							|  |  |  |     http | 
					
						
							|  |  |  |     http.client | 
					
						
							|  |  |  |     io.encodings.binary | 
					
						
							|  |  |  |     json.reader | 
					
						
							|  |  |  |     json.writer | 
					
						
							|  |  |  |     kernel | 
					
						
							|  |  |  |     locals | 
					
						
							|  |  |  |     namespaces | 
					
						
							|  |  |  |     sequences | 
					
						
							|  |  |  |     strings | 
					
						
							|  |  |  |     urls | 
					
						
							|  |  |  | ;
 | 
					
						
							|  |  |  | IN: bitcoin.client | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : bitcoin-server ( -- string )
 | 
					
						
							|  |  |  |     \ bitcoin-server get "localhost" or ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : bitcoin-port ( -- n )
 | 
					
						
							|  |  |  |     \ bitcoin-port get 8332 or ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : bitcoin-user ( -- string )
 | 
					
						
							|  |  |  |     \ bitcoin-user get "" or ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : bitcoin-password ( -- string )
 | 
					
						
							|  |  |  |     \ bitcoin-password get ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : bitcoin-url ( -- url )
 | 
					
						
							|  |  |  |     <url> | 
					
						
							|  |  |  |       "http" >>protocol | 
					
						
							|  |  |  |       "/" >>path | 
					
						
							|  |  |  |       bitcoin-server >>host | 
					
						
							|  |  |  |       bitcoin-port >>port ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: payload ( method params -- data )  | 
					
						
							|  |  |  |     "text/plain" <post-data> | 
					
						
							|  |  |  |         binary >>content-encoding | 
					
						
							|  |  |  |         H{ | 
					
						
							|  |  |  |             { "method" method } | 
					
						
							|  |  |  |             { "params" params } | 
					
						
							|  |  |  |         } clone >json >byte-array >>data ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : basic-auth ( -- string )
 | 
					
						
							|  |  |  |     bitcoin-user bitcoin-password ":" glue >base64 >string
 | 
					
						
							|  |  |  |     "Basic " prepend ;  | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : bitcoin-request ( method params -- request )
 | 
					
						
							|  |  |  |     payload bitcoin-url <post-request>  | 
					
						
							|  |  |  |     basic-auth "Authorization" set-header | 
					
						
							|  |  |  |     dup post-data>> data>> length "Content-Length" set-header | 
					
						
							| 
									
										
										
										
											2013-10-12 13:57:08 -04:00
										 |  |  |     http-request* >string json> "result" of ;
 | 
					
						
							| 
									
										
										
										
											2010-09-22 02:03:34 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: get-addresses-by-label ( label -- seq )
 | 
					
						
							|  |  |  |     "getaddressesbylabel" { label } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : get-balance ( -- n )
 | 
					
						
							|  |  |  |     "getbalance" { } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : get-block-count ( -- n )
 | 
					
						
							|  |  |  |     "getblockcount" { } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : get-block-number ( -- n )
 | 
					
						
							|  |  |  |     "getblocknumber" { } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : get-connection-count ( -- n )
 | 
					
						
							|  |  |  |     "getconnectioncount" { } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : get-difficulty ( -- n )
 | 
					
						
							|  |  |  |     "getdifficulty" { } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : get-generate ( -- ? )
 | 
					
						
							|  |  |  |     "getgenerate" { } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: set-generate ( gen n -- )
 | 
					
						
							|  |  |  |     "setgenerate" { gen n } bitcoin-request  drop ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : get-info ( -- result )
 | 
					
						
							|  |  |  |     "getinfo" { } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: get-label ( address -- label )
 | 
					
						
							|  |  |  |     "getlabel" { address } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: set-label ( address label -- )
 | 
					
						
							|  |  |  |     "setlabel" { address  label } bitcoin-request  drop ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: remove-label ( address -- )
 | 
					
						
							|  |  |  |     "setlabel" { address } bitcoin-request  drop ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : get-new-address ( -- address )
 | 
					
						
							|  |  |  |     "getnewaddress" { } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: get-new-labelled-address ( label -- address )
 | 
					
						
							|  |  |  |     "getnewaddress" { label } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: get-received-by-address ( address -- amount )
 | 
					
						
							|  |  |  |     "getreceivedbyaddress" { address } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: get-confirmed-received-by-address ( address minconf -- amount )
 | 
					
						
							|  |  |  |     "getreceivedbyaddress" { address minconf } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: get-received-by-label ( label -- amount )
 | 
					
						
							|  |  |  |     "getreceivedbylabel" { label } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: get-confirmed-received-by-label ( label minconf -- amount )
 | 
					
						
							|  |  |  |     "getreceivedbylabel" { label minconf } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: list-received-by-address ( minconf include-empty -- seq )
 | 
					
						
							|  |  |  |     "listreceivedbyaddress" { minconf include-empty } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: list-received-by-label ( minconf include-empty -- seq )
 | 
					
						
							|  |  |  |     "listreceivedbylabel" { minconf include-empty } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | :: send-to-address ( address amount -- ? )
 | 
					
						
							|  |  |  |     "sendtoaddress" { address amount } bitcoin-request "sent" = ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : stop ( -- )
 | 
					
						
							|  |  |  |     "stop" { } bitcoin-request drop ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #! requires patched bitcoind | 
					
						
							|  |  |  | :: list-transactions ( count include-generated -- seq )
 | 
					
						
							|  |  |  |     "listtransactions" { count include-generated } bitcoin-request ;
 | 
					
						
							|  |  |  | 
 |