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

{- |
Module      : Haskoin.Transaction.Common
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX

Code related to transactions parsing and serialization.
-}
module Haskoin.Transaction.Common (
    -- * Transactions
    Tx (..),
    TxIn (..),
    TxOut (..),
    OutPoint (..),
    TxHash (..),
    WitnessData,
    WitnessStack,
    WitnessStackItem,
    txHash,
    hexToTxHash,
    txHashToHex,
    nosigTxHash,
    nullOutPoint,
) where

import Control.Applicative ((<|>))
import Control.DeepSeq
import Control.Monad (
    forM_,
    guard,
    liftM2,
    mzero,
    replicateM,
    unless,
    when,
    (<=<),
 )
import Data.Aeson as A
import Data.Aeson.Encoding (unsafeToEncoding)
import Data.Binary (Binary (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteString.Builder (char7)
import qualified Data.ByteString.Lazy as BL
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Hashable (Hashable)
import Data.Maybe (fromMaybe)
import Data.Serialize (Serialize (..))
import Data.String (IsString, fromString)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Haskoin.Crypto.Hash
import Haskoin.Network.Common
import Haskoin.Util
import Text.Read as R

-- | Transaction id: hash of transaction excluding witness data.
newtype TxHash = TxHash {TxHash -> Hash256
getTxHash :: Hash256}
    deriving (TxHash -> TxHash -> Bool
(TxHash -> TxHash -> Bool)
-> (TxHash -> TxHash -> Bool) -> Eq TxHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxHash -> TxHash -> Bool
$c/= :: TxHash -> TxHash -> Bool
== :: TxHash -> TxHash -> Bool
$c== :: TxHash -> TxHash -> Bool
Eq, Eq TxHash
Eq TxHash
-> (TxHash -> TxHash -> Ordering)
-> (TxHash -> TxHash -> Bool)
-> (TxHash -> TxHash -> Bool)
-> (TxHash -> TxHash -> Bool)
-> (TxHash -> TxHash -> Bool)
-> (TxHash -> TxHash -> TxHash)
-> (TxHash -> TxHash -> TxHash)
-> Ord TxHash
TxHash -> TxHash -> Bool
TxHash -> TxHash -> Ordering
TxHash -> TxHash -> TxHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxHash -> TxHash -> TxHash
$cmin :: TxHash -> TxHash -> TxHash
max :: TxHash -> TxHash -> TxHash
$cmax :: TxHash -> TxHash -> TxHash
>= :: TxHash -> TxHash -> Bool
$c>= :: TxHash -> TxHash -> Bool
> :: TxHash -> TxHash -> Bool
$c> :: TxHash -> TxHash -> Bool
<= :: TxHash -> TxHash -> Bool
$c<= :: TxHash -> TxHash -> Bool
< :: TxHash -> TxHash -> Bool
$c< :: TxHash -> TxHash -> Bool
compare :: TxHash -> TxHash -> Ordering
$ccompare :: TxHash -> TxHash -> Ordering
$cp1Ord :: Eq TxHash
Ord, (forall x. TxHash -> Rep TxHash x)
-> (forall x. Rep TxHash x -> TxHash) -> Generic TxHash
forall x. Rep TxHash x -> TxHash
forall x. TxHash -> Rep TxHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxHash x -> TxHash
$cfrom :: forall x. TxHash -> Rep TxHash x
Generic, Int -> TxHash -> Int
TxHash -> Int
(Int -> TxHash -> Int) -> (TxHash -> Int) -> Hashable TxHash
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TxHash -> Int
$chash :: TxHash -> Int
hashWithSalt :: Int -> TxHash -> Int
$chashWithSalt :: Int -> TxHash -> Int
Hashable, (forall (m :: * -> *). MonadPut m => TxHash -> m ())
-> (forall (m :: * -> *). MonadGet m => m TxHash) -> Serial TxHash
forall a.
(forall (m :: * -> *). MonadPut m => a -> m ())
-> (forall (m :: * -> *). MonadGet m => m a) -> Serial a
forall (m :: * -> *). MonadPut m => TxHash -> m ()
forall (m :: * -> *). MonadGet m => m TxHash
deserialize :: m TxHash
$cdeserialize :: forall (m :: * -> *). MonadGet m => m TxHash
serialize :: TxHash -> m ()
$cserialize :: forall (m :: * -> *). MonadPut m => TxHash -> m ()
Serial, TxHash -> ()
(TxHash -> ()) -> NFData TxHash
forall a. (a -> ()) -> NFData a
rnf :: TxHash -> ()
$crnf :: TxHash -> ()
NFData)

instance Serialize TxHash where
    put :: Putter TxHash
put = Putter TxHash
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get TxHash
get = Get TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Binary TxHash where
    put :: TxHash -> Put
put = TxHash -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get TxHash
get = Get TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Show TxHash where
    showsPrec :: Int -> TxHash -> ShowS
showsPrec Int
_ = Text -> ShowS
forall a. Show a => a -> ShowS
shows (Text -> ShowS) -> (TxHash -> Text) -> TxHash -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> Text
txHashToHex

instance Read TxHash where
    readPrec :: ReadPrec TxHash
readPrec = do
        R.String String
str <- ReadPrec Lexeme
R.lexP
        ReadPrec TxHash
-> (TxHash -> ReadPrec TxHash) -> Maybe TxHash -> ReadPrec TxHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec TxHash
forall a. ReadPrec a
R.pfail TxHash -> ReadPrec TxHash
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TxHash -> ReadPrec TxHash)
-> Maybe TxHash -> ReadPrec TxHash
forall a b. (a -> b) -> a -> b
$ Text -> Maybe TxHash
hexToTxHash (Text -> Maybe TxHash) -> Text -> Maybe TxHash
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
str

instance IsString TxHash where
    fromString :: String -> TxHash
fromString String
s =
        let e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"Could not read transaction hash from hex string"
         in TxHash -> Maybe TxHash -> TxHash
forall a. a -> Maybe a -> a
fromMaybe TxHash
forall a. a
e (Maybe TxHash -> TxHash) -> Maybe TxHash -> TxHash
forall a b. (a -> b) -> a -> b
$ Text -> Maybe TxHash
hexToTxHash (Text -> Maybe TxHash) -> Text -> Maybe TxHash
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
s

instance FromJSON TxHash where
    parseJSON :: Value -> Parser TxHash
parseJSON =
        String -> (Text -> Parser TxHash) -> Value -> Parser TxHash
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"txid" ((Text -> Parser TxHash) -> Value -> Parser TxHash)
-> (Text -> Parser TxHash) -> Value -> Parser TxHash
forall a b. (a -> b) -> a -> b
$
            Parser TxHash
-> (TxHash -> Parser TxHash) -> Maybe TxHash -> Parser TxHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser TxHash
forall (m :: * -> *) a. MonadPlus m => m a
mzero TxHash -> Parser TxHash
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TxHash -> Parser TxHash)
-> (Text -> Maybe TxHash) -> Text -> Parser TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe TxHash
hexToTxHash

instance ToJSON TxHash where
    toJSON :: TxHash -> Value
toJSON = Text -> Value
A.String (Text -> Value) -> (TxHash -> Text) -> TxHash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> Text
txHashToHex
    toEncoding :: TxHash -> Encoding
toEncoding TxHash
h =
        Builder -> Encoding
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding) -> Builder -> Encoding
forall a b. (a -> b) -> a -> b
$
            Char -> Builder
char7 Char
'"'
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
hexBuilder (ByteString -> ByteString
BL.reverse (Put -> ByteString
runPutL (TxHash -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize TxHash
h)))
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'"'

-- | Transaction hash excluding signatures.
nosigTxHash :: Tx -> TxHash
nosigTxHash :: Tx -> TxHash
nosigTxHash Tx
tx =
    Hash256 -> TxHash
TxHash (Hash256 -> TxHash) -> Hash256 -> TxHash
forall a b. (a -> b) -> a -> b
$
        ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 (ByteString -> Hash256) -> ByteString -> Hash256
forall a b. (a -> b) -> a -> b
$
            Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$
                Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Tx
tx{txIn :: [TxIn]
txIn = (TxIn -> TxIn) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxIn
clearInput ([TxIn] -> [TxIn]) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> a -> b
$ Tx -> [TxIn]
txIn Tx
tx}
  where
    clearInput :: TxIn -> TxIn
clearInput TxIn
ti = TxIn
ti{scriptInput :: ByteString
scriptInput = ByteString
B.empty}

-- | Convert transaction hash to hex form, reversing bytes.
txHashToHex :: TxHash -> Text
txHashToHex :: TxHash -> Text
txHashToHex (TxHash Hash256
h) = ByteString -> Text
encodeHex (ByteString -> ByteString
B.reverse (Put -> ByteString
runPutS (Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
h)))

-- | Convert transaction hash from hex, reversing bytes.
hexToTxHash :: Text -> Maybe TxHash
hexToTxHash :: Text -> Maybe TxHash
hexToTxHash Text
hex = do
    ByteString
bs <- ByteString -> ByteString
B.reverse (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe ByteString
decodeHex Text
hex
    Hash256
h <- (String -> Maybe Hash256)
-> (Hash256 -> Maybe Hash256)
-> Either String Hash256
-> Maybe Hash256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Hash256 -> String -> Maybe Hash256
forall a b. a -> b -> a
const Maybe Hash256
forall a. Maybe a
Nothing) Hash256 -> Maybe Hash256
forall a. a -> Maybe a
Just (Get Hash256 -> ByteString -> Either String Hash256
forall a. Get a -> ByteString -> Either String a
runGetS Get Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
bs)
    TxHash -> Maybe TxHash
forall (m :: * -> *) a. Monad m => a -> m a
return (TxHash -> Maybe TxHash) -> TxHash -> Maybe TxHash
forall a b. (a -> b) -> a -> b
$ Hash256 -> TxHash
TxHash Hash256
h

-- | Witness stack for SegWit transactions.
type WitnessData = [WitnessStack]

-- | Witness stack for SegWit transactions.
type WitnessStack = [WitnessStackItem]

-- | Witness stack item for SegWit transactions.
type WitnessStackItem = ByteString

-- | Data type representing a transaction.
data Tx = Tx
    { -- | transaction data format version
      Tx -> Word32
txVersion :: !Word32
    , -- | list of transaction inputs
      Tx -> [TxIn]
txIn :: ![TxIn]
    , -- | list of transaction outputs
      Tx -> [TxOut]
txOut :: ![TxOut]
    , -- | witness data for the transaction
      Tx -> WitnessData
txWitness :: !WitnessData
    , -- | earliest mining height or time
      Tx -> Word32
txLockTime :: !Word32
    }
    deriving (Int -> Tx -> ShowS
[Tx] -> ShowS
Tx -> String
(Int -> Tx -> ShowS)
-> (Tx -> String) -> ([Tx] -> ShowS) -> Show Tx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tx] -> ShowS
$cshowList :: [Tx] -> ShowS
show :: Tx -> String
$cshow :: Tx -> String
showsPrec :: Int -> Tx -> ShowS
$cshowsPrec :: Int -> Tx -> ShowS
Show, ReadPrec [Tx]
ReadPrec Tx
Int -> ReadS Tx
ReadS [Tx]
(Int -> ReadS Tx)
-> ReadS [Tx] -> ReadPrec Tx -> ReadPrec [Tx] -> Read Tx
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tx]
$creadListPrec :: ReadPrec [Tx]
readPrec :: ReadPrec Tx
$creadPrec :: ReadPrec Tx
readList :: ReadS [Tx]
$creadList :: ReadS [Tx]
readsPrec :: Int -> ReadS Tx
$creadsPrec :: Int -> ReadS Tx
Read, Tx -> Tx -> Bool
(Tx -> Tx -> Bool) -> (Tx -> Tx -> Bool) -> Eq Tx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tx -> Tx -> Bool
$c/= :: Tx -> Tx -> Bool
== :: Tx -> Tx -> Bool
$c== :: Tx -> Tx -> Bool
Eq, Eq Tx
Eq Tx
-> (Tx -> Tx -> Ordering)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Tx)
-> (Tx -> Tx -> Tx)
-> Ord Tx
Tx -> Tx -> Bool
Tx -> Tx -> Ordering
Tx -> Tx -> Tx
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tx -> Tx -> Tx
$cmin :: Tx -> Tx -> Tx
max :: Tx -> Tx -> Tx
$cmax :: Tx -> Tx -> Tx
>= :: Tx -> Tx -> Bool
$c>= :: Tx -> Tx -> Bool
> :: Tx -> Tx -> Bool
$c> :: Tx -> Tx -> Bool
<= :: Tx -> Tx -> Bool
$c<= :: Tx -> Tx -> Bool
< :: Tx -> Tx -> Bool
$c< :: Tx -> Tx -> Bool
compare :: Tx -> Tx -> Ordering
$ccompare :: Tx -> Tx -> Ordering
$cp1Ord :: Eq Tx
Ord, (forall x. Tx -> Rep Tx x)
-> (forall x. Rep Tx x -> Tx) -> Generic Tx
forall x. Rep Tx x -> Tx
forall x. Tx -> Rep Tx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tx x -> Tx
$cfrom :: forall x. Tx -> Rep Tx x
Generic, Int -> Tx -> Int
Tx -> Int
(Int -> Tx -> Int) -> (Tx -> Int) -> Hashable Tx
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Tx -> Int
$chash :: Tx -> Int
hashWithSalt :: Int -> Tx -> Int
$chashWithSalt :: Int -> Tx -> Int
Hashable, Tx -> ()
(Tx -> ()) -> NFData Tx
forall a. (a -> ()) -> NFData a
rnf :: Tx -> ()
$crnf :: Tx -> ()
NFData)

-- | Compute transaction hash.
txHash :: Tx -> TxHash
txHash :: Tx -> TxHash
txHash Tx
tx = Hash256 -> TxHash
TxHash (Hash256 -> TxHash) -> (Put -> Hash256) -> Put -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 (ByteString -> Hash256) -> (Put -> ByteString) -> Put -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> TxHash) -> Put -> TxHash
forall a b. (a -> b) -> a -> b
$ Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Tx
tx{txWitness :: WitnessData
txWitness = []}

instance IsString Tx where
    fromString :: String -> Tx
fromString =
        Tx -> Maybe Tx -> Tx
forall a. a -> Maybe a -> a
fromMaybe Tx
forall a. a
e (Maybe Tx -> Tx) -> (String -> Maybe Tx) -> String -> Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String Tx -> Maybe Tx
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String Tx -> Maybe Tx)
-> (ByteString -> Either String Tx) -> ByteString -> Maybe Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get Tx -> ByteString -> Either String Tx
forall a. Get a -> ByteString -> Either String a
runGetS Get Tx
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> Maybe Tx)
-> (Text -> Maybe ByteString) -> Text -> Maybe Tx
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeHex) (Text -> Maybe Tx) -> (String -> Text) -> String -> Maybe Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs
      where
        e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"Could not read transaction from hex string"

instance Serial Tx where
    deserialize :: m Tx
deserialize =
        m Bool
forall (m :: * -> *). MonadGet m => m Bool
isWitnessTx m Bool -> (Bool -> m Tx) -> m Tx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
w -> if Bool
w then m Tx
forall (m :: * -> *). MonadGet m => m Tx
parseWitnessTx else m Tx
forall (m :: * -> *). MonadGet m => m Tx
parseLegacyTx
    serialize :: Tx -> m ()
serialize Tx
tx
        | WitnessData -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Tx -> WitnessData
txWitness Tx
tx) = Tx -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
putLegacyTx Tx
tx
        | Bool
otherwise = Tx -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
putWitnessTx Tx
tx

instance Binary Tx where
    put :: Tx -> Put
put = Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get Tx
get = Get Tx
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serialize Tx where
    put :: Tx -> Put
put = Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get Tx
get = Get Tx
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

putInOut :: MonadPut m => Tx -> m ()
putInOut :: Tx -> m ()
putInOut Tx
tx = do
    Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [TxIn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxIn]
txIn Tx
tx)
    [TxIn] -> (TxIn -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Tx -> [TxIn]
txIn Tx
tx) TxIn -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [TxOut] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxOut]
txOut Tx
tx)
    [TxOut] -> (TxOut -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Tx -> [TxOut]
txOut Tx
tx) TxOut -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

-- | Non-SegWit transaction serializer.
putLegacyTx :: MonadPut m => Tx -> m ()
putLegacyTx :: Tx -> m ()
putLegacyTx Tx
tx = do
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Tx -> Word32
txVersion Tx
tx)
    Tx -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
putInOut Tx
tx
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Tx -> Word32
txLockTime Tx
tx)

-- | Witness transaciton serializer.
putWitnessTx :: MonadPut m => Tx -> m ()
putWitnessTx :: Tx -> m ()
putWitnessTx Tx
tx = do
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Tx -> Word32
txVersion Tx
tx)
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x01
    Tx -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
putInOut Tx
tx
    WitnessData -> m ()
forall (m :: * -> *). MonadPut m => WitnessData -> m ()
putWitnessData (Tx -> WitnessData
txWitness Tx
tx)
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Tx -> Word32
txLockTime Tx
tx)

isWitnessTx :: MonadGet m => m Bool
isWitnessTx :: m Bool
isWitnessTx = m Bool -> m Bool
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Word32
_ <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
    Word8
m <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
    Word8
f <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
    Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00 Bool -> Bool -> Bool
&& Word8
f Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x01)

-- | Non-SegWit transaction deseralizer.
parseLegacyTx :: MonadGet m => m Tx
parseLegacyTx :: m Tx
parseLegacyTx = do
    Word32
v <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
    [TxIn]
is <- VarInt -> m [TxIn]
forall (m :: * -> *) a. (Serial a, MonadGet m) => VarInt -> m [a]
replicateList (VarInt -> m [TxIn]) -> m VarInt -> m [TxIn]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    [TxOut]
os <- VarInt -> m [TxOut]
forall (m :: * -> *) a. (Serial a, MonadGet m) => VarInt -> m [a]
replicateList (VarInt -> m [TxOut]) -> m VarInt -> m [TxOut]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([TxIn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
is Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x00 Bool -> Bool -> Bool
&& [TxOut] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut]
os Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x01) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Witness transaction"
    Word32
l <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
    Tx -> m Tx
forall (m :: * -> *) a. Monad m => a -> m a
return
        Tx :: Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx
            { txVersion :: Word32
txVersion = Word32
v
            , txIn :: [TxIn]
txIn = [TxIn]
is
            , txOut :: [TxOut]
txOut = [TxOut]
os
            , txWitness :: WitnessData
txWitness = []
            , txLockTime :: Word32
txLockTime = Word32
l
            }
  where
    replicateList :: VarInt -> m [a]
replicateList (VarInt Word64
c) = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Witness transaction deserializer.
parseWitnessTx :: MonadGet m => m Tx
parseWitnessTx :: m Tx
parseWitnessTx = do
    Word32
v <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
    Word8
m <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
    Word8
f <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00 Bool -> Bool -> Bool
&& Word8
f Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x01) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a witness transaction"
    [TxIn]
is <- VarInt -> m [TxIn]
forall (m :: * -> *) a. (Serial a, MonadGet m) => VarInt -> m [a]
replicateList (VarInt -> m [TxIn]) -> m VarInt -> m [TxIn]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    [TxOut]
os <- VarInt -> m [TxOut]
forall (m :: * -> *) a. (Serial a, MonadGet m) => VarInt -> m [a]
replicateList (VarInt -> m [TxOut]) -> m VarInt -> m [TxOut]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    WitnessData
w <- Int -> m WitnessData
forall (m :: * -> *). MonadGet m => Int -> m WitnessData
parseWitnessData (Int -> m WitnessData) -> Int -> m WitnessData
forall a b. (a -> b) -> a -> b
$ [TxIn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
is
    Word32
l <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
    Tx -> m Tx
forall (m :: * -> *) a. Monad m => a -> m a
return
        Tx :: Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx{txVersion :: Word32
txVersion = Word32
v, txIn :: [TxIn]
txIn = [TxIn]
is, txOut :: [TxOut]
txOut = [TxOut]
os, txWitness :: WitnessData
txWitness = WitnessData
w, txLockTime :: Word32
txLockTime = Word32
l}
  where
    replicateList :: VarInt -> m [a]
replicateList (VarInt Word64
c) = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Witness data deserializer. Requires count of inputs.
parseWitnessData :: MonadGet m => Int -> m WitnessData
parseWitnessData :: Int -> m WitnessData
parseWitnessData Int
n = Int -> m [ByteString] -> m WitnessData
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n m [ByteString]
parseWitnessStack
  where
    parseWitnessStack :: m [ByteString]
parseWitnessStack = do
        VarInt Word64
i <- m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Int -> m ByteString -> m [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i) m ByteString
parseWitnessStackItem
    parseWitnessStackItem :: m ByteString
parseWitnessStackItem = do
        VarInt Word64
i <- m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString (Int -> m ByteString) -> Int -> m ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

-- | Witness data serializer.
putWitnessData :: MonadPut m => WitnessData -> m ()
putWitnessData :: WitnessData -> m ()
putWitnessData = ([ByteString] -> m ()) -> WitnessData -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [ByteString] -> m ()
forall (m :: * -> *) (t :: * -> *).
(MonadPut m, Foldable t) =>
t ByteString -> m ()
putWitnessStack
  where
    putWitnessStack :: t ByteString -> m ()
putWitnessStack t ByteString
ws = do
        Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ t ByteString -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t ByteString
ws
        (ByteString -> m ()) -> t ByteString -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putWitnessStackItem t ByteString
ws
    putWitnessStackItem :: ByteString -> m ()
putWitnessStackItem ByteString
bs = do
        Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
bs

instance FromJSON Tx where
    parseJSON :: Value -> Parser Tx
parseJSON = String -> (Object -> Parser Tx) -> Value -> Parser Tx
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Tx" ((Object -> Parser Tx) -> Value -> Parser Tx)
-> (Object -> Parser Tx) -> Value -> Parser Tx
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx (Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx)
-> Parser Word32
-> Parser ([TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
            Parser ([TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx)
-> Parser [TxIn] -> Parser ([TxOut] -> WitnessData -> Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [TxIn]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inputs"
            Parser ([TxOut] -> WitnessData -> Word32 -> Tx)
-> Parser [TxOut] -> Parser (WitnessData -> Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [TxOut]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"outputs"
            Parser (WitnessData -> Word32 -> Tx)
-> Parser WitnessData -> Parser (Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([Text] -> Parser [ByteString]) -> [[Text]] -> Parser WitnessData
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Text -> Parser ByteString) -> [Text] -> Parser [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Parser ByteString
f) ([[Text]] -> Parser WitnessData)
-> Parser [[Text]] -> Parser WitnessData
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser [[Text]]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"witnessdata")
            Parser (Word32 -> Tx) -> Parser Word32 -> Parser Tx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locktime"
      where
        f :: Text -> Parser ByteString
f = Parser ByteString
-> (ByteString -> Parser ByteString)
-> Maybe ByteString
-> Parser ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser ByteString
forall (m :: * -> *) a. MonadPlus m => m a
mzero ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> Parser ByteString)
-> (Text -> Maybe ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex

instance ToJSON Tx where
    toJSON :: Tx -> Value
toJSON (Tx Word32
v [TxIn]
i [TxOut]
o WitnessData
w Word32
l) =
        [Pair] -> Value
object
            [ Key
"version" Key -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
v
            , Key
"inputs" Key -> [TxIn] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [TxIn]
i
            , Key
"outputs" Key -> [TxOut] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [TxOut]
o
            , Key
"witnessdata" Key -> [[Text]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ([ByteString] -> [Text]) -> WitnessData -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Text) -> [ByteString] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
encodeHex) WitnessData
w
            , Key
"locktime" Key -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
l
            ]
    toEncoding :: Tx -> Encoding
toEncoding (Tx Word32
v [TxIn]
i [TxOut]
o WitnessData
w Word32
l) =
        Series -> Encoding
pairs
            ( Key
"version" Key -> Word32 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
v
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"inputs" Key -> [TxIn] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [TxIn]
i
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"outputs" Key -> [TxOut] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [TxOut]
o
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"witnessdata" Key -> [[Text]] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ([ByteString] -> [Text]) -> WitnessData -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Text) -> [ByteString] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
encodeHex) WitnessData
w
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"locktime" Key -> Word32 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
l
            )

-- | Data type representing a transaction input.
data TxIn = TxIn
    { -- | output being spent
      TxIn -> OutPoint
prevOutput :: !OutPoint
    , -- | signatures and redeem script
      TxIn -> ByteString
scriptInput :: !ByteString
    , -- | lock-time using sequence numbers (BIP-68)
      TxIn -> Word32
txInSequence :: !Word32
    }
    deriving (TxIn -> TxIn -> Bool
(TxIn -> TxIn -> Bool) -> (TxIn -> TxIn -> Bool) -> Eq TxIn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxIn -> TxIn -> Bool
$c/= :: TxIn -> TxIn -> Bool
== :: TxIn -> TxIn -> Bool
$c== :: TxIn -> TxIn -> Bool
Eq, Int -> TxIn -> ShowS
[TxIn] -> ShowS
TxIn -> String
(Int -> TxIn -> ShowS)
-> (TxIn -> String) -> ([TxIn] -> ShowS) -> Show TxIn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxIn] -> ShowS
$cshowList :: [TxIn] -> ShowS
show :: TxIn -> String
$cshow :: TxIn -> String
showsPrec :: Int -> TxIn -> ShowS
$cshowsPrec :: Int -> TxIn -> ShowS
Show, ReadPrec [TxIn]
ReadPrec TxIn
Int -> ReadS TxIn
ReadS [TxIn]
(Int -> ReadS TxIn)
-> ReadS [TxIn] -> ReadPrec TxIn -> ReadPrec [TxIn] -> Read TxIn
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TxIn]
$creadListPrec :: ReadPrec [TxIn]
readPrec :: ReadPrec TxIn
$creadPrec :: ReadPrec TxIn
readList :: ReadS [TxIn]
$creadList :: ReadS [TxIn]
readsPrec :: Int -> ReadS TxIn
$creadsPrec :: Int -> ReadS TxIn
Read, Eq TxIn
Eq TxIn
-> (TxIn -> TxIn -> Ordering)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> TxIn)
-> (TxIn -> TxIn -> TxIn)
-> Ord TxIn
TxIn -> TxIn -> Bool
TxIn -> TxIn -> Ordering
TxIn -> TxIn -> TxIn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxIn -> TxIn -> TxIn
$cmin :: TxIn -> TxIn -> TxIn
max :: TxIn -> TxIn -> TxIn
$cmax :: TxIn -> TxIn -> TxIn
>= :: TxIn -> TxIn -> Bool
$c>= :: TxIn -> TxIn -> Bool
> :: TxIn -> TxIn -> Bool
$c> :: TxIn -> TxIn -> Bool
<= :: TxIn -> TxIn -> Bool
$c<= :: TxIn -> TxIn -> Bool
< :: TxIn -> TxIn -> Bool
$c< :: TxIn -> TxIn -> Bool
compare :: TxIn -> TxIn -> Ordering
$ccompare :: TxIn -> TxIn -> Ordering
$cp1Ord :: Eq TxIn
Ord, (forall x. TxIn -> Rep TxIn x)
-> (forall x. Rep TxIn x -> TxIn) -> Generic TxIn
forall x. Rep TxIn x -> TxIn
forall x. TxIn -> Rep TxIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxIn x -> TxIn
$cfrom :: forall x. TxIn -> Rep TxIn x
Generic, Int -> TxIn -> Int
TxIn -> Int
(Int -> TxIn -> Int) -> (TxIn -> Int) -> Hashable TxIn
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TxIn -> Int
$chash :: TxIn -> Int
hashWithSalt :: Int -> TxIn -> Int
$chashWithSalt :: Int -> TxIn -> Int
Hashable, TxIn -> ()
(TxIn -> ()) -> NFData TxIn
forall a. (a -> ()) -> NFData a
rnf :: TxIn -> ()
$crnf :: TxIn -> ()
NFData)

instance Serial TxIn where
    deserialize :: m TxIn
deserialize =
        OutPoint -> ByteString -> Word32 -> TxIn
TxIn (OutPoint -> ByteString -> Word32 -> TxIn)
-> m OutPoint -> m (ByteString -> Word32 -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m OutPoint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m (ByteString -> Word32 -> TxIn)
-> m ByteString -> m (Word32 -> TxIn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VarInt -> m ByteString
forall (m :: * -> *). MonadGet m => VarInt -> m ByteString
readBS (VarInt -> m ByteString) -> m VarInt -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize) m (Word32 -> TxIn) -> m Word32 -> m TxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
      where
        readBS :: VarInt -> m ByteString
readBS (VarInt Word64
len) = Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString (Int -> m ByteString) -> Int -> m ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len

    serialize :: TxIn -> m ()
serialize (TxIn OutPoint
o ByteString
s Word32
q) = do
        OutPoint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize OutPoint
o
        Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
s
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
s
        Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
q

instance Binary TxIn where
    get :: Get TxIn
get = Get TxIn
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    put :: TxIn -> Put
put = TxIn -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

instance Serialize TxIn where
    get :: Get TxIn
get = Get TxIn
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    put :: Putter TxIn
put = Putter TxIn
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

instance FromJSON TxIn where
    parseJSON :: Value -> Parser TxIn
parseJSON =
        String -> (Object -> Parser TxIn) -> Value -> Parser TxIn
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TxIn" ((Object -> Parser TxIn) -> Value -> Parser TxIn)
-> (Object -> Parser TxIn) -> Value -> Parser TxIn
forall a b. (a -> b) -> a -> b
$ \Object
o ->
            OutPoint -> ByteString -> Word32 -> TxIn
TxIn (OutPoint -> ByteString -> Word32 -> TxIn)
-> Parser OutPoint -> Parser (ByteString -> Word32 -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser OutPoint
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prevoutput"
                Parser (ByteString -> Word32 -> TxIn)
-> Parser ByteString -> Parser (Word32 -> TxIn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString
-> (ByteString -> Parser ByteString)
-> Maybe ByteString
-> Parser ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser ByteString
forall (m :: * -> *) a. MonadPlus m => m a
mzero ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> Parser ByteString)
-> (Text -> Maybe ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> Parser ByteString) -> Parser Text -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inputscript")
                Parser (Word32 -> TxIn) -> Parser Word32 -> Parser TxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sequence"

instance ToJSON TxIn where
    toJSON :: TxIn -> Value
toJSON (TxIn OutPoint
o ByteString
s Word32
q) =
        [Pair] -> Value
object
            [ Key
"prevoutput" Key -> OutPoint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OutPoint
o
            , Key
"inputscript" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
encodeHex ByteString
s
            , Key
"sequence" Key -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
q
            ]
    toEncoding :: TxIn -> Encoding
toEncoding (TxIn OutPoint
o ByteString
s Word32
q) =
        Series -> Encoding
pairs
            ( Key
"prevoutput" Key -> OutPoint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OutPoint
o
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"inputscript" Key -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
encodeHex ByteString
s
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"sequence" Key -> Word32 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
q
            )

-- | Data type representing a transaction output.
data TxOut = TxOut
    { -- | value of output is satoshi
      TxOut -> Word64
outValue :: !Word64
    , -- | pubkey script
      TxOut -> ByteString
scriptOutput :: !ByteString
    }
    deriving (TxOut -> TxOut -> Bool
(TxOut -> TxOut -> Bool) -> (TxOut -> TxOut -> Bool) -> Eq TxOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOut -> TxOut -> Bool
$c/= :: TxOut -> TxOut -> Bool
== :: TxOut -> TxOut -> Bool
$c== :: TxOut -> TxOut -> Bool
Eq, Int -> TxOut -> ShowS
[TxOut] -> ShowS
TxOut -> String
(Int -> TxOut -> ShowS)
-> (TxOut -> String) -> ([TxOut] -> ShowS) -> Show TxOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOut] -> ShowS
$cshowList :: [TxOut] -> ShowS
show :: TxOut -> String
$cshow :: TxOut -> String
showsPrec :: Int -> TxOut -> ShowS
$cshowsPrec :: Int -> TxOut -> ShowS
Show, ReadPrec [TxOut]
ReadPrec TxOut
Int -> ReadS TxOut
ReadS [TxOut]
(Int -> ReadS TxOut)
-> ReadS [TxOut]
-> ReadPrec TxOut
-> ReadPrec [TxOut]
-> Read TxOut
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TxOut]
$creadListPrec :: ReadPrec [TxOut]
readPrec :: ReadPrec TxOut
$creadPrec :: ReadPrec TxOut
readList :: ReadS [TxOut]
$creadList :: ReadS [TxOut]
readsPrec :: Int -> ReadS TxOut
$creadsPrec :: Int -> ReadS TxOut
Read, Eq TxOut
Eq TxOut
-> (TxOut -> TxOut -> Ordering)
-> (TxOut -> TxOut -> Bool)
-> (TxOut -> TxOut -> Bool)
-> (TxOut -> TxOut -> Bool)
-> (TxOut -> TxOut -> Bool)
-> (TxOut -> TxOut -> TxOut)
-> (TxOut -> TxOut -> TxOut)
-> Ord TxOut
TxOut -> TxOut -> Bool
TxOut -> TxOut -> Ordering
TxOut -> TxOut -> TxOut
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxOut -> TxOut -> TxOut
$cmin :: TxOut -> TxOut -> TxOut
max :: TxOut -> TxOut -> TxOut
$cmax :: TxOut -> TxOut -> TxOut
>= :: TxOut -> TxOut -> Bool
$c>= :: TxOut -> TxOut -> Bool
> :: TxOut -> TxOut -> Bool
$c> :: TxOut -> TxOut -> Bool
<= :: TxOut -> TxOut -> Bool
$c<= :: TxOut -> TxOut -> Bool
< :: TxOut -> TxOut -> Bool
$c< :: TxOut -> TxOut -> Bool
compare :: TxOut -> TxOut -> Ordering
$ccompare :: TxOut -> TxOut -> Ordering
$cp1Ord :: Eq TxOut
Ord, (forall x. TxOut -> Rep TxOut x)
-> (forall x. Rep TxOut x -> TxOut) -> Generic TxOut
forall x. Rep TxOut x -> TxOut
forall x. TxOut -> Rep TxOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxOut x -> TxOut
$cfrom :: forall x. TxOut -> Rep TxOut x
Generic, Int -> TxOut -> Int
TxOut -> Int
(Int -> TxOut -> Int) -> (TxOut -> Int) -> Hashable TxOut
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TxOut -> Int
$chash :: TxOut -> Int
hashWithSalt :: Int -> TxOut -> Int
$chashWithSalt :: Int -> TxOut -> Int
Hashable, TxOut -> ()
(TxOut -> ()) -> NFData TxOut
forall a. (a -> ()) -> NFData a
rnf :: TxOut -> ()
$crnf :: TxOut -> ()
NFData)

instance Serial TxOut where
    deserialize :: m TxOut
deserialize = do
        Word64
val <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le
        VarInt Word64
len <- m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Word64 -> ByteString -> TxOut
TxOut Word64
val (ByteString -> TxOut) -> m ByteString -> m TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len)

    serialize :: TxOut -> m ()
serialize (TxOut Word64
o ByteString
s) = do
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le Word64
o
        Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
s
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
s

instance Binary TxOut where
    put :: TxOut -> Put
put = TxOut -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get TxOut
get = Get TxOut
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serialize TxOut where
    put :: Putter TxOut
put = Putter TxOut
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get TxOut
get = Get TxOut
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance FromJSON TxOut where
    parseJSON :: Value -> Parser TxOut
parseJSON =
        String -> (Object -> Parser TxOut) -> Value -> Parser TxOut
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TxOut" ((Object -> Parser TxOut) -> Value -> Parser TxOut)
-> (Object -> Parser TxOut) -> Value -> Parser TxOut
forall a b. (a -> b) -> a -> b
$ \Object
o ->
            Word64 -> ByteString -> TxOut
TxOut (Word64 -> ByteString -> TxOut)
-> Parser Word64 -> Parser (ByteString -> TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
                Parser (ByteString -> TxOut) -> Parser ByteString -> Parser TxOut
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString
-> (ByteString -> Parser ByteString)
-> Maybe ByteString
-> Parser ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser ByteString
forall (m :: * -> *) a. MonadPlus m => m a
mzero ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> Parser ByteString)
-> (Text -> Maybe ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> Parser ByteString) -> Parser Text -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"outputscript")

instance ToJSON TxOut where
    toJSON :: TxOut -> Value
toJSON (TxOut Word64
o ByteString
s) =
        [Pair] -> Value
object [Key
"value" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64
o, Key
"outputscript" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
encodeHex ByteString
s]
    toEncoding :: TxOut -> Encoding
toEncoding (TxOut Word64
o ByteString
s) =
        Series -> Encoding
pairs (Key
"value" Key -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64
o Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"outputscript" Key -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
encodeHex ByteString
s)

-- | The 'OutPoint' refers to a transaction output being spent.
data OutPoint = OutPoint
    { -- | hash of previous transaction
      OutPoint -> TxHash
outPointHash :: !TxHash
    , -- | position of output in previous transaction
      OutPoint -> Word32
outPointIndex :: !Word32
    }
    deriving (Int -> OutPoint -> ShowS
[OutPoint] -> ShowS
OutPoint -> String
(Int -> OutPoint -> ShowS)
-> (OutPoint -> String) -> ([OutPoint] -> ShowS) -> Show OutPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutPoint] -> ShowS
$cshowList :: [OutPoint] -> ShowS
show :: OutPoint -> String
$cshow :: OutPoint -> String
showsPrec :: Int -> OutPoint -> ShowS
$cshowsPrec :: Int -> OutPoint -> ShowS
Show, ReadPrec [OutPoint]
ReadPrec OutPoint
Int -> ReadS OutPoint
ReadS [OutPoint]
(Int -> ReadS OutPoint)
-> ReadS [OutPoint]
-> ReadPrec OutPoint
-> ReadPrec [OutPoint]
-> Read OutPoint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OutPoint]
$creadListPrec :: ReadPrec [OutPoint]
readPrec :: ReadPrec OutPoint
$creadPrec :: ReadPrec OutPoint
readList :: ReadS [OutPoint]
$creadList :: ReadS [OutPoint]
readsPrec :: Int -> ReadS OutPoint
$creadsPrec :: Int -> ReadS OutPoint
Read, OutPoint -> OutPoint -> Bool
(OutPoint -> OutPoint -> Bool)
-> (OutPoint -> OutPoint -> Bool) -> Eq OutPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutPoint -> OutPoint -> Bool
$c/= :: OutPoint -> OutPoint -> Bool
== :: OutPoint -> OutPoint -> Bool
$c== :: OutPoint -> OutPoint -> Bool
Eq, Eq OutPoint
Eq OutPoint
-> (OutPoint -> OutPoint -> Ordering)
-> (OutPoint -> OutPoint -> Bool)
-> (OutPoint -> OutPoint -> Bool)
-> (OutPoint -> OutPoint -> Bool)
-> (OutPoint -> OutPoint -> Bool)
-> (OutPoint -> OutPoint -> OutPoint)
-> (OutPoint -> OutPoint -> OutPoint)
-> Ord OutPoint
OutPoint -> OutPoint -> Bool
OutPoint -> OutPoint -> Ordering
OutPoint -> OutPoint -> OutPoint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutPoint -> OutPoint -> OutPoint
$cmin :: OutPoint -> OutPoint -> OutPoint
max :: OutPoint -> OutPoint -> OutPoint
$cmax :: OutPoint -> OutPoint -> OutPoint
>= :: OutPoint -> OutPoint -> Bool
$c>= :: OutPoint -> OutPoint -> Bool
> :: OutPoint -> OutPoint -> Bool
$c> :: OutPoint -> OutPoint -> Bool
<= :: OutPoint -> OutPoint -> Bool
$c<= :: OutPoint -> OutPoint -> Bool
< :: OutPoint -> OutPoint -> Bool
$c< :: OutPoint -> OutPoint -> Bool
compare :: OutPoint -> OutPoint -> Ordering
$ccompare :: OutPoint -> OutPoint -> Ordering
$cp1Ord :: Eq OutPoint
Ord, (forall x. OutPoint -> Rep OutPoint x)
-> (forall x. Rep OutPoint x -> OutPoint) -> Generic OutPoint
forall x. Rep OutPoint x -> OutPoint
forall x. OutPoint -> Rep OutPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutPoint x -> OutPoint
$cfrom :: forall x. OutPoint -> Rep OutPoint x
Generic, Int -> OutPoint -> Int
OutPoint -> Int
(Int -> OutPoint -> Int) -> (OutPoint -> Int) -> Hashable OutPoint
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OutPoint -> Int
$chash :: OutPoint -> Int
hashWithSalt :: Int -> OutPoint -> Int
$chashWithSalt :: Int -> OutPoint -> Int
Hashable, OutPoint -> ()
(OutPoint -> ()) -> NFData OutPoint
forall a. (a -> ()) -> NFData a
rnf :: OutPoint -> ()
$crnf :: OutPoint -> ()
NFData)

instance Serial OutPoint where
    deserialize :: m OutPoint
deserialize = do
        (TxHash
h, Word32
i) <- (TxHash -> Word32 -> (TxHash, Word32))
-> m TxHash -> m Word32 -> m (TxHash, Word32)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
        OutPoint -> m OutPoint
forall (m :: * -> *) a. Monad m => a -> m a
return (OutPoint -> m OutPoint) -> OutPoint -> m OutPoint
forall a b. (a -> b) -> a -> b
$ TxHash -> Word32 -> OutPoint
OutPoint TxHash
h Word32
i
    serialize :: OutPoint -> m ()
serialize (OutPoint TxHash
h Word32
i) = TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize TxHash
h m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
i

instance Binary OutPoint where
    put :: OutPoint -> Put
put = OutPoint -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get OutPoint
get = Get OutPoint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serialize OutPoint where
    put :: Putter OutPoint
put = Putter OutPoint
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get OutPoint
get = Get OutPoint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance FromJSON OutPoint where
    parseJSON :: Value -> Parser OutPoint
parseJSON =
        String -> (Object -> Parser OutPoint) -> Value -> Parser OutPoint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OutPoint" ((Object -> Parser OutPoint) -> Value -> Parser OutPoint)
-> (Object -> Parser OutPoint) -> Value -> Parser OutPoint
forall a b. (a -> b) -> a -> b
$ \Object
o ->
            TxHash -> Word32 -> OutPoint
OutPoint (TxHash -> Word32 -> OutPoint)
-> Parser TxHash -> Parser (Word32 -> OutPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txid" Parser (Word32 -> OutPoint) -> Parser Word32 -> Parser OutPoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"

instance ToJSON OutPoint where
    toJSON :: OutPoint -> Value
toJSON (OutPoint TxHash
h Word32
i) = [Pair] -> Value
object [Key
"txid" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxHash
h, Key
"index" Key -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
i]
    toEncoding :: OutPoint -> Encoding
toEncoding (OutPoint TxHash
h Word32
i) = Series -> Encoding
pairs (Key
"txid" Key -> TxHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxHash
h Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"index" Key -> Word32 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
i)

-- | Outpoint used in coinbase transactions.
nullOutPoint :: OutPoint
nullOutPoint :: OutPoint
nullOutPoint =
    OutPoint :: TxHash -> Word32 -> OutPoint
OutPoint
        { outPointHash :: TxHash
outPointHash =
            TxHash
"0000000000000000000000000000000000000000000000000000000000000000"
        , outPointIndex :: Word32
outPointIndex = Word32
forall a. Bounded a => a
maxBound
        }