module Network.Bitcoin.Api.Transaction where
import Data.Aeson
import Data.Aeson.Lens
import Data.Maybe (fromMaybe)
import Control.Lens ((^.), (^?))
import qualified Data.Base58String as B58S
import qualified Data.Bitcoin.Transaction as Btc
import qualified Data.Bitcoin.Block as Btc (Block (..))
import qualified Network.Bitcoin.Api.Blockchain as Blockchain
import qualified Data.Bitcoin.Types as BT
import qualified Network.Bitcoin.Api.Internal as I
import qualified Network.Bitcoin.Api.Types as T
import Network.Bitcoin.Api.Types.UnspentTransaction
create :: T.Client
-> [UnspentTransaction]
-> [(BT.Address, BT.Btc)]
-> IO Btc.Transaction
create client utxs outputs =
let configuration = [toJSON (map txToOutpoint utxs), object (map outToAddress outputs)]
txToOutpoint tx = object [
("txid", toJSON (tx ^. transactionId)),
("vout", toJSON (tx ^. vout))]
outToAddress (addr, btc) = (B58S.toText addr, toJSON btc)
in (return . Btc.decode) =<< I.call client "createrawtransaction" configuration
sign :: T.Client
-> Btc.Transaction
-> Maybe [UnspentTransaction]
-> Maybe [BT.PrivateKey]
-> IO (Btc.Transaction, Bool)
sign client tx utxs pks =
let configuration = [configurationTx tx, configurationUtxs utxs, configurationPks pks]
configurationTx tx' =
toJSON (Btc.encode tx')
configurationUtxs Nothing = Null
configurationUtxs (Just utxs') =
toJSON (map utxToDependency utxs')
where
utxToDependency utx = object [
("txid", toJSON (utx ^. transactionId)),
("vout", toJSON (utx ^. vout)),
("scriptPubKey", toJSON (utx ^. scriptPubKey)),
("redeemScript", toJSON (utx ^. redeemScript))]
configurationPks Nothing = Null
configurationPks (Just privateKeys) =
toJSON privateKeys
extractTransaction res =
maybe
(error "Incorrect JSON response")
Btc.decode
(res ^? key "hex" . _JSON)
extractCompleted res =
fromMaybe
(error "Incorrect JSON response")
(res ^? key "complete" . _JSON)
in do
res <- I.call client "signrawtransaction" configuration :: IO Value
return (extractTransaction res, extractCompleted res)
send :: T.Client
-> Btc.Transaction
-> IO BT.TransactionId
send client tx =
let configuration = [toJSON (Btc.encode tx)]
in I.call client "sendrawtransaction" configuration
list :: T.Client
-> Maybe Integer
-> IO [Btc.Transaction]
list client Nothing = list client (Just 0)
list client (Just offset) = do
limit <- Blockchain.getBlockCount client
blocks <- mapM (Blockchain.getBlock client) =<< mapM (Blockchain.getBlockHash client) [offset..limit 1]
return $ foldl (\lhs rhs -> lhs ++ Btc.blockTxns rhs) [] blocks