{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Bitcoin.Core.RPC.Transactions (
getTransaction,
sendRawTransaction,
sendTransaction,
MempoolTestResult (..),
testMempoolAccept,
) where
import Data.Aeson (FromJSON (..), withObject, (.:), (.:?))
import Data.Proxy (Proxy (..))
import qualified Data.Serialize as S
import Data.Text (Text)
import Haskoin.Block (BlockHash)
import Haskoin.Transaction (Tx, TxHash)
import Haskoin.Util (encodeHex)
import Servant.API ((:<|>) (..))
import Servant.Bitcoind (
BitcoindClient,
BitcoindEndpoint,
C,
DefFalse,
F,
HexEncoded (..),
I,
O,
toBitcoindClient,
)
data MempoolTestResult = MempoolTestResult
{ MempoolTestResult -> TxHash
testTxid :: TxHash
, MempoolTestResult -> Bool
txAccepted :: Bool
, MempoolTestResult -> Maybe Text
rejectReason :: Maybe Text
}
deriving (MempoolTestResult -> MempoolTestResult -> Bool
(MempoolTestResult -> MempoolTestResult -> Bool)
-> (MempoolTestResult -> MempoolTestResult -> Bool)
-> Eq MempoolTestResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MempoolTestResult -> MempoolTestResult -> Bool
$c/= :: MempoolTestResult -> MempoolTestResult -> Bool
== :: MempoolTestResult -> MempoolTestResult -> Bool
$c== :: MempoolTestResult -> MempoolTestResult -> Bool
Eq, Int -> MempoolTestResult -> ShowS
[MempoolTestResult] -> ShowS
MempoolTestResult -> String
(Int -> MempoolTestResult -> ShowS)
-> (MempoolTestResult -> String)
-> ([MempoolTestResult] -> ShowS)
-> Show MempoolTestResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MempoolTestResult] -> ShowS
$cshowList :: [MempoolTestResult] -> ShowS
show :: MempoolTestResult -> String
$cshow :: MempoolTestResult -> String
showsPrec :: Int -> MempoolTestResult -> ShowS
$cshowsPrec :: Int -> MempoolTestResult -> ShowS
Show)
instance FromJSON MempoolTestResult where
parseJSON :: Value -> Parser MempoolTestResult
parseJSON = String
-> (Object -> Parser MempoolTestResult)
-> Value
-> Parser MempoolTestResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "MempoolTestResult" ((Object -> Parser MempoolTestResult)
-> Value -> Parser MempoolTestResult)
-> (Object -> Parser MempoolTestResult)
-> Value
-> Parser MempoolTestResult
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
TxHash -> Bool -> Maybe Text -> MempoolTestResult
MempoolTestResult (TxHash -> Bool -> Maybe Text -> MempoolTestResult)
-> Parser TxHash
-> Parser (Bool -> Maybe Text -> MempoolTestResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "txid" Parser (Bool -> Maybe Text -> MempoolTestResult)
-> Parser Bool -> Parser (Maybe Text -> MempoolTestResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "allowed" Parser (Maybe Text -> MempoolTestResult)
-> Parser (Maybe Text) -> Parser MempoolTestResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "reject-reason"
type RawTxRpc =
BitcoindEndpoint "sendrawtransaction" (I Text -> O Double -> C TxHash)
:<|> BitcoindEndpoint "getrawtransaction" (I TxHash -> F DefFalse Bool -> O BlockHash -> C (HexEncoded Tx))
:<|> BitcoindEndpoint "testmempoolaccept" (I [Tx] -> O Double -> C [MempoolTestResult])
sendRawTransaction :: Text -> Maybe Double -> BitcoindClient TxHash
sendTransaction :: Tx -> Maybe Double -> BitcoindClient TxHash
sendTransaction :: Tx -> Maybe Double -> BitcoindClient TxHash
sendTransaction = Text -> Maybe Double -> BitcoindClient TxHash
sendRawTransaction (Text -> Maybe Double -> BitcoindClient TxHash)
-> (Tx -> Text) -> Tx -> Maybe Double -> BitcoindClient TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text) -> (Tx -> ByteString) -> Tx -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> ByteString
forall a. Serialize a => a -> ByteString
S.encode
getTransaction' :: TxHash -> Maybe BlockHash -> BitcoindClient (HexEncoded Tx)
testMempoolAccept :: [Tx] -> Maybe Double -> BitcoindClient [MempoolTestResult]
sendRawTransaction :: Text -> Maybe Double -> BitcoindClient TxHash
sendRawTransaction :<|> getTransaction' :: TxHash -> Maybe BlockHash -> BitcoindClient (HexEncoded Tx)
getTransaction' :<|> testMempoolAccept :: [Tx] -> Maybe Double -> BitcoindClient [MempoolTestResult]
testMempoolAccept = Proxy RawTxRpc
-> (Text -> Maybe Double -> BitcoindClient TxHash)
:<|> ((TxHash -> Maybe BlockHash -> BitcoindClient (HexEncoded Tx))
:<|> ([Tx] -> Maybe Double -> BitcoindClient [MempoolTestResult]))
forall x (p :: * -> *).
HasBitcoindClient x =>
p x -> TheBitcoindClient x
toBitcoindClient (Proxy RawTxRpc
-> (Text -> Maybe Double -> BitcoindClient TxHash)
:<|> ((TxHash -> Maybe BlockHash -> BitcoindClient (HexEncoded Tx))
:<|> ([Tx] -> Maybe Double -> BitcoindClient [MempoolTestResult])))
-> Proxy RawTxRpc
-> (Text -> Maybe Double -> BitcoindClient TxHash)
:<|> ((TxHash -> Maybe BlockHash -> BitcoindClient (HexEncoded Tx))
:<|> ([Tx] -> Maybe Double -> BitcoindClient [MempoolTestResult]))
forall a b. (a -> b) -> a -> b
$ Proxy RawTxRpc
forall k (t :: k). Proxy t
Proxy @RawTxRpc
getTransaction :: TxHash -> Maybe BlockHash -> BitcoindClient Tx
getTransaction :: TxHash -> Maybe BlockHash -> BitcoindClient Tx
getTransaction h :: TxHash
h = (HexEncoded Tx -> Tx)
-> BitcoindClient (HexEncoded Tx) -> BitcoindClient Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HexEncoded Tx -> Tx
forall a. HexEncoded a -> a
unHexEncoded (BitcoindClient (HexEncoded Tx) -> BitcoindClient Tx)
-> (Maybe BlockHash -> BitcoindClient (HexEncoded Tx))
-> Maybe BlockHash
-> BitcoindClient Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> Maybe BlockHash -> BitcoindClient (HexEncoded Tx)
getTransaction' TxHash
h