burnt-explorer-2.0.0: Main.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import qualified Data.Bitcoin.Script as BS
import Data.Aeson
import Data.ByteString.Lazy.Char8 (ByteString, pack, unpack)
import qualified Data.Csv as Csv
import Data.List
import Data.Scientific (Scientific, FPFormat(Fixed), formatScientific)
import GHC.Generics
import System.Environment
import System.IO
import System.Process

getBlackcoindCommand :: IO String
getBlackcoindCommand = do
  customName <- lookupEnv "BLACKCOIND_COMMAND"
  case customName of
    Just name -> return name
    Nothing -> return "blackcoind"

execCommand :: String -> [String] -> IO String
execCommand command args = do
  blackcoindCommand <- getBlackcoindCommand
  let fullCommand = intercalate " " ([blackcoindCommand, command] ++ args)
  readCreateProcess (shell fullCommand) ""

data Block = Block {
  hash :: String,
  height :: Int,
  time :: Int,
  tx :: [String]
  } deriving (Generic, Show)
instance FromJSON Block

data Tx = Tx {
  txid :: String,
  vout :: [VOut]
  } deriving (Generic, Show)
instance FromJSON Tx

data VOut = VOut {
  n :: Int,
  scriptHex :: String,
  value :: Scientific,
  script :: BS.Script
  } deriving (Show)
instance FromJSON VOut where
  parseJSON (Object o) = do
    n <- o .: "n"
    hex <- ((o .: "scriptPubKey") >>= (.: "hex"))
    value <- o .: "value"
    return (VOut n hex value (BS.decode (pack hex)))

getBlockByNumber :: Int -> IO Block
getBlockByNumber n = do
  -- hPutStr stderr ("\rFetching block " ++ (show n) ++ "…")
  blockJSON <- execCommand "getblockbynumber" [(show n)]
  case decode (pack blockJSON) of
    Just block -> return block

getTxsFromBlock :: Block -> IO [Tx]
getTxsFromBlock block =
  sequence (map getTx (tx block))

getTx :: String -> IO Tx
getTx idx = do
  -- hPutStr stderr ("\rFetching transaction " ++ idx ++ "…")
  txJSON <- execCommand "gettransaction" [idx]
  case decode (pack txJSON) of
    Just tx -> return tx

ourEncodeOptions :: Csv.EncodeOptions
ourEncodeOptions = Csv.defaultEncodeOptions {
  Csv.encQuoting = Csv.QuoteMinimal
  }

blockTxVoutToCSV :: (Block, Tx, VOut) -> ByteString
blockTxVoutToCSV (block, tx, vout) =
  Csv.encodeWith ourEncodeOptions [(show (height block),
                                    hash block,
                                    show (time block),
                                    txid tx,
                                    show (n vout),
                                    formatScientific Fixed (Just 0) (100000000 * (value vout)),
                                    scriptHex vout,
                                    show (BS.scriptOps (script vout)))]

processTxs :: [Int] -> IO ()
processTxs [] = return ()
processTxs (height:heights) = do
  block <- getBlockByNumber height
  txs <- getTxsFromBlock block
  let txs_vouts = concat [zip3 (repeat block) (repeat tx) (vout tx) | tx <- txs]
  let third (_, _, x) = x
  let interesting = filter ((elem BS.OP_RETURN) . BS.scriptOps . script . third) txs_vouts
  mapM_ (putStr . unpack . blockTxVoutToCSV) interesting
  processTxs heights

main :: IO ()
main = do
  hSetBuffering stdout LineBuffering
  args <- getArgs
  let [start, stop] = map read (take 2 args) :: [Int]
  processTxs [start..stop]