メモ：WannaCryの送金データをblockchain .infoのAPIから取ってきてグラフを描きたい

R ggplot2 API

追記（2017/05/21）：

ツイートの主によるやり方解説ブログはこちら。

これを描きたい。が、元データはどこを見ればいいのかよくわからず調べた時のメモ。

Bitcoinについてさっぱり分からないのでググったら以下の資料を発見。トランザクションとかアドレスの概念は以下の資料の19ページ目以降に書いてあってなんか分かった気になれた（たぶん分かってない）。

このWannaCryの送金先は、以下の3つのアドレスがあることがとりあえずわかってるらしい。他にもあるのかな？

各アドレスのトランザクションのデータはblockchain.infoというサイトのAPIから取れる。

「Multi Address」というAPIより「Single Address」の方が扱いやすそうだったのでそっちを使ってみる。どうもlimitがうまく効いてない気がしつつ…

library(httr)

res <- GET(sprintf("https://blockchain.info/rawaddr/%s",
                   "115p7UMMngoj1pMvkpHijcRdfJNXj6LrLn"),
           query = list(
             limit = 50L,
             offset = 0L
           ))

j <- content(res)

str(j, max.level = 1)
#> List of 7
#>  $ hash160       : chr "00e8fd98ca34f195b020af4a8b1c7238663d4212"
#>  $ address       : chr "115p7UMMngoj1pMvkpHijcRdfJNXj6LrLn"
#>  $ n_tx          : int 40
#>  $ total_received: int 500870623
#>  $ total_sent    : int 0
#>  $ final_balance : int 500870623
#>  $ txs           :List of 40

どうやらこのtxsというやつがトランザクションらしい。ひとつ覗いてみる。

str(j$txs[[1]])
#> List of 13
#>  $ ver         : int 1
#>  $ inputs      :List of 1
#>   ..$ :List of 3
#>   .. ..$ sequence: num 4.29e+09
#>   .. ..$ prev_out:List of 7
#>   .. .. ..$ spent   : logi TRUE
#>   .. .. ..$ tx_index: int 250652451
#>   .. .. ..$ type    : int 0
#>   .. .. ..$ addr    : chr "1942StxVu1PtQwQuWZ6TQf1MQEEXwfAuNT"
#>   .. .. ..$ value   : int 75750000
#>   .. .. ..$ n       : int 0
#>   .. .. ..$ script  : chr "76a9145853762c746941b39525c66bd1a99c98a7ad6d8c88ac"
#>   .. ..$ script  : chr "47304402204d927fac9298e4150788dd9c5ccda31de395b0c026e68fa846a29f190b23c38902201d2e90bd17c0b82d0fd9cdfa21a331763"| __truncated__
#>  $ block_height: int 466428
#>  $ relayed_by  : chr "188.165.196.19"
#>  $ out         :List of 2
#>   ..$ :List of 7
#>   .. ..$ spent   : logi FALSE
#>   .. ..$ tx_index: int 250741847
#>   .. ..$ type    : int 0
#>   .. ..$ addr    : chr "115p7UMMngoj1pMvkpHijcRdfJNXj6LrLn"
#>   .. ..$ value   : int 33353900
#>   .. ..$ n       : int 0
#>   .. ..$ script  : chr "76a91400e8fd98ca34f195b020af4a8b1c7238663d421288ac"
#>   ..$ :List of 7
#>   .. ..$ spent   : logi TRUE
#>   .. ..$ tx_index: int 250741847
#>   .. ..$ type    : int 0
#>   .. ..$ addr    : chr "1NtjJcV3mts54dgt1qydUYjC9GmxYp9Jea"
#>   .. ..$ value   : int 42336319
#>   .. ..$ n       : int 1
#>   .. ..$ script  : chr "76a914f0232b37d18cc92dc02e675a2366c3ee823ac50f88ac"
#>  $ lock_time   : int 0
#>  $ result      : int 0
#>  $ size        : int 225
#>  $ time        : int 1494801126
#>  $ tx_index    : int 250741847
#>  $ vin_sz      : int 1
#>  $ hash        : chr "d20d48e0f63e791ba577f98b41b78218bf9942a433a6720bf90194317442741d"
#>  $ vout_sz     : int 2

あんまり概念がよくわかってないけど、今回欲しいのはどれくらいの額を送金したのか、という程度なのでとりあえずoutがあればいい。これは形式の揃ったリストなのでdplyr::bind_rows()すればいい。

library(dplyr, warn.conflicts = FALSE)

bind_rows(j$txs[[1]]$out)
#> # A tibble: 2 × 7
#>   spent  tx_index  type                               addr    value     n
#>   <lgl>     <int> <int>                              <chr>    <int> <int>
#> 1 FALSE 250741847     0 115p7UMMngoj1pMvkpHijcRdfJNXj6LrLn 33353900     0
#> 2  TRUE 250741847     0 1NtjJcV3mts54dgt1qydUYjC9GmxYp9Jea 42336319     1
#> # ... with 1 more variables: script <chr>

で、残りの要素を付け加えるのは、tidyevalを使ってみる（なんかもっとさくっとできる気はしつつ…）

# 入れ子になっていない要素だけ抜き出す
atomic_attrs <- purrr::keep(j$txs[[1]], purrr::is_bare_atomic)

bind_rows(j$txs[[1]]$out) %>%
  mutate(!!! atomic_attrs)
#> # A tibble: 2 × 17
#>   spent  tx_index  type                               addr    value     n
#>   <lgl>     <int> <int>                              <chr>    <int> <int>
#> 1 FALSE 250741847     0 115p7UMMngoj1pMvkpHijcRdfJNXj6LrLn 33353900     0
#> 2  TRUE 250741847     0 1NtjJcV3mts54dgt1qydUYjC9GmxYp9Jea 42336319     1
#> # ... with 11 more variables: script <chr>, ver <int>, block_height <int>, relayed_by <chr>, lock_time <int>,
#> #   result <int>, size <int>, time <int>, vin_sz <int>, hash <chr>, vout_sz <int>

ということで、全データを取ってくるには3つのアドレスの送金データをoffsetを変えつつ取らないとだめだけど、とりあえずこれは実験ということでこのデータだけでグラフを描いてみる。

こんな感じ？

d <- map(j$txs,
         function(x) {
           atom_attrs <- keep(x, is_scalar_atomic)
           bind_rows(x$out) %>%
             mutate(!!! atom_attrs)
         }) %>%
  bind_rows %>%
  mutate(timestamp = as.POSIXct(d$time, origin = '1970-01-01'),
         date = lubridate::date(timestamp))

library(ggplot2)
ggplot(d, aes(date, value)) + geom_col(colour = "white")

f:id:yutannihilation:20170515084315p:plain:w450

うーん、あってるのか間違ってるのかよくわからない…。詳しい方はツッコミをいただけると助かります。