module Bitcoin.BlockChain.Tx where
import Prelude
import Data.Int
import Data.Word
import Data.List ( mapAccumL , foldl' )
import Data.Maybe
import Control.Monad
import Control.Applicative
import Data.Foldable ( Foldable(..) )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Binary
import Data.Binary.Get
import Bitcoin.Misc.Bifunctor
import Bitcoin.Misc.HexString
import Bitcoin.Misc.UnixTime
import Bitcoin.Protocol.Hash
newtype RawTx = RawTx { unRawTx :: B.ByteString } deriving Eq
instance Show RawTx where
showsPrec d (RawTx rs) = showParen (d>10) $ showString "RawTx " . shows (toHexStringChars rs)
data LockTime
= LockImmed
| LockBlock !Int
| LockTime !UnixTimeStamp
deriving (Eq,Show)
parseLockTime :: Word32 -> LockTime
parseLockTime !w
| w == 0 = LockImmed
| w < 500000000 = LockBlock (fromIntegral w)
| otherwise = LockTime (UnixTimeStamp w)
marshalLockTime :: LockTime -> Word32
marshalLockTime lt = case lt of
LockImmed -> 0
LockBlock n -> fromIntegral n
LockTime (UnixTimeStamp w) -> w
data Tx inscript outscript = Tx
{ _txVersion :: !Word32
, _txInputs :: [TxInput inscript ]
, _txOutputs :: [TxOutput outscript]
, _txLockTime :: !LockTime
, _txHash :: Hash256
}
deriving (Eq,Show)
instance BiFunctor Tx where
fmapFst f (Tx ver ins outs lock hash) = Tx ver (map (fmap f) ins) outs lock hash
fmapSnd g (Tx ver ins outs lock hash) = Tx ver ins (map (fmap g) outs) lock hash
fmapBoth f g (Tx ver ins outs lock hash) = Tx ver (map (fmap f) ins) (map (fmap g) outs) lock hash
instance BiFoldable Tx where
bifoldl f g x0 (Tx ver ins outs lock hash) = Prelude.foldl g (Prelude.foldl f x0 (map _txInScript ins )) (map _txOutScript outs)
bifoldr f g (Tx ver ins outs lock hash) x0 = Prelude.foldr f (Prelude.foldr g x0 (map _txOutScript outs)) (map _txInScript ins )
instance BiTraversable Tx where
mapAccumLFst f acc (Tx ver ins outs lock hash) = (acc', Tx ver ins' outs lock hash) where
(acc', ins' ) = mapAccumL h acc ins
h a txin = let (a',y) = f a (_txInScript txin )
in (a', txin { _txInScript = y })
mapAccumLSnd g acc (Tx ver ins outs lock hash) = (acc', Tx ver ins outs' lock hash) where
(acc', outs') = mapAccumL h acc outs
h a txout = let (a',y) = g a (_txOutScript txout)
in (a', txout { _txOutScript = y })
data TxInput inscript = TxInput
{ _txInPrevOutHash :: !Hash256
, _txInPrevOutIdx :: !Word32
, _txInScript :: !inscript
, _txInSeqNo :: !Word32
}
deriving (Eq,Show,Functor)
data TxOutput outscript = TxOutput
{ _txOutValue :: !Int64
, _txOutScript :: !outscript
}
deriving (Eq,Show,Functor)
txFee :: Tx (Tx a b) c -> Integer
txFee txExt = totalInput totalOutput where
totalOutput = sum' [ fromIntegral (_txOutValue txout) | txout <- _txOutputs txExt ]
totalInput = sum' [ inputValue txin | txin <- _txInputs txExt ]
inputValue :: TxInput (Tx a b) -> Integer
inputValue txin = fromIntegral
$ _txOutValue ( (_txOutputs $ _txInScript txin) !! (fromIntegral $ _txInPrevOutIdx txin) )
sum' :: [Integer] -> Integer
sum' = Data.List.foldl' (+) 0
isCoinBaseTx :: Tx a b -> Bool
isCoinBaseTx = isJust . isCoinBaseTx'
isCoinBaseTx' :: Tx a b -> Maybe a
isCoinBaseTx' tx = case _txInputs tx of
[inp] -> if _txInPrevOutHash inp == zeroHash256
then Just (_txInScript inp)
else Nothing
_ -> Nothing