{-# 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])

-- | Submit a raw transaction (serialized, hex-encoded) to local node and network.
sendRawTransaction :: Text -> Maybe Double -> BitcoindClient TxHash

-- | A version of 'sendRawTransaction' that handles serialization
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)

{- | Returns result of mempool acceptance tests indicating if the transactions
 would be accepted by mempool.  This checks if the transaction violates the
 consensus or policy rules.
-}
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

{- | By default this function only works for mempool transactions. When called
 with a blockhash argument, getrawtransaction will return the transaction if
 the specified block is available and the transaction is found in that block.
 When called without a blockhash argument, getrawtransaction will return the
 transaction if it is in the mempool, or if -txindex is enabled and the
 transaction is in a block in the blockchain.
-}
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