{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}
module Network.Bitcoin.Mining ( Client
, getClient
, getGenerate
, setGenerate
, generate
, generateToAddress
, getHashesPerSec
, MiningInfo(..)
, getMiningInfo
, HashData(..)
, getWork
, solveBlock
, Transaction(..)
, CoinBaseAux(..)
, BlockTemplate(..)
, getBlockTemplate
, submitBlock
) where
import Control.Exception (catch, throw)
import Control.Monad
import Data.Aeson as A
import Network.Bitcoin.Internal
import Network.Bitcoin.Wallet (getNewAddress)
import Network.HTTP.Client (HttpException (..),
HttpExceptionContent (..),
responseStatus)
import Network.HTTP.Types (status500)
getGenerate :: Client
-> IO Bool
getGenerate client = callApi client "getgenerate" []
setGenerate :: Client
-> Bool
-> Maybe Int
-> IO (Maybe [HexString])
setGenerate client onOff Nothing =
unArr <$> callApi client "setgenerate" [ tj onOff ]
setGenerate client onOff (Just limit) =
unArr <$> callApi client "setgenerate" [ tj onOff, tj limit ]
generate :: Client
-> Int
-> Maybe Int
-> IO [HexString]
generate client blocks maxTries =
callApi client "generate" args `catch` onFail
where
args = tj blocks : maybe [] (pure . tj) maxTries
onFail (HttpExceptionRequest _ (StatusCodeException rsp _))
| responseStatus rsp == status500
= getNewAddress client Nothing >>= flip (generateToAddress client blocks) maxTries
onFail e = throw e
generateToAddress :: Client
-> Int
-> Address
-> Maybe Int
-> IO [HexString]
generateToAddress client blocks address Nothing =
callApi client "generatetoaddress" [ tj blocks, tj address ]
generateToAddress client blocks address (Just maxTries) =
callApi client "generatetoaddress" [ tj blocks, tj address, tj maxTries ]
getHashesPerSec :: Client -> IO Integer
getHashesPerSec client = callApi client "gethashespersec" []
data MiningInfo =
MiningInfo {
nBlocks :: Integer
, currentBlockSize :: Integer
, currentBlockTransaction :: Integer
, difficulty :: Double
, miningErrors :: Text
, isGenerating :: Bool
, generationProcessorLimit :: Integer
, hashesPerSecond :: Integer
, pooledTransactions :: Integer
, miningOnTestNetwork :: Bool
}
deriving ( Show, Read, Ord, Eq )
instance FromJSON MiningInfo where
parseJSON (Object o) = MiningInfo <$> o .: "blocks"
<*> o .: "currentblocksize"
<*> o .: "currentblocktx"
<*> o .: "difficulty"
<*> o .: "errors"
<*> o .: "generate"
<*> o .: "genproclimit"
<*> o .: "hashespersec"
<*> o .: "pooledtx"
<*> o .: "testnet"
parseJSON _ = mzero
getMiningInfo :: Client -> IO MiningInfo
getMiningInfo client = callApi client "getmininginfo" []
data HashData =
HashData { blockData :: HexString
, hdTarget :: HexString
, hash1 :: HexString
, midstate :: HexString
}
deriving ( Show, Read, Ord, Eq )
instance FromJSON HashData where
parseJSON (Object o) = HashData <$> o .: "data"
<*> o .: "target"
<*> o .: "hash1"
<*> o .: "midstate"
parseJSON _ = mzero
instance ToJSON HashData where
toJSON (HashData dat tar has mid) = object ["data" .= dat, "target" .= tar, "hash1" .= has, "midstate" .= mid]
getWork :: Client -> IO HashData
getWork client = callApi client "getwork" []
solveBlock :: Client -> HexString -> IO Bool
solveBlock client data_ = callApi client "getwork" [ tj data_ ]
data Transaction =
Transaction { txnData :: HexString
, txnHash :: HexString
, depends :: Vector Integer
, txnFee :: Maybe Integer
, sigOps :: Integer
}
deriving ( Show, Read, Ord, Eq )
instance FromJSON Transaction where
parseJSON (Object o) = Transaction <$> o .: "data"
<*> o .: "hash"
<*> o .: "depends"
<*> o .:? "fee"
<*> o .: "sigops"
parseJSON _ = mzero
newtype CoinBaseAux = CoinBaseAux { cbFlags :: HexString }
deriving ( Show, Read, Ord, Eq )
instance FromJSON CoinBaseAux where
parseJSON (Object o) = CoinBaseAux <$> o .: "flags"
parseJSON _ = mzero
data BlockTemplate =
BlockTemplate { blockVersion :: Integer
, previousBlockHash :: HexString
, transactionsToInclude :: Vector Transaction
, coinBaseAux :: CoinBaseAux
, coinBaseValue :: Integer
, btTarget :: HexString
, minTime :: Integer
, nonceRange :: HexString
, sigopLimit :: Integer
, sizeLimit :: Integer
, curTime :: Integer
, btBits :: HexString
, btHeight :: Integer
}
deriving ( Show, Read, Ord, Eq )
instance FromJSON BlockTemplate where
parseJSON (Object o) = BlockTemplate <$> o .: "version"
<*> o .: "previousblockhash"
<*> o .: "transactions"
<*> o .: "coinbaseaux"
<*> o .: "coinbasevalue"
<*> o .: "target"
<*> o .: "mintime"
<*> o .: "noncerange"
<*> o .: "sigoplimit"
<*> o .: "sizelimit"
<*> o .: "curtime"
<*> o .: "bits"
<*> o .: "height"
parseJSON _ = mzero
getBlockTemplate :: Client -> IO BlockTemplate
getBlockTemplate client = callApi client "getblocktemplate" []
newtype StupidReturnValue = SRV { unStupid :: Bool }
instance FromJSON StupidReturnValue where
parseJSON Null = return $ SRV True
parseJSON _ = return $ SRV False
submitBlock :: Client
-> HexString
-> IO Bool
submitBlock client block = unStupid <$> callApi client "submitblock" [ tj block ]