module Data.Bitcoin.Transaction.Types where
import Control.Applicative ((<$>), (<*>))
import Control.Lens.TH (makeLenses)
import Control.Monad (forM_, liftM2, replicateM, unless)
import Data.Word (Word32, Word64)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Binary (Binary, decode, encode, get, put)
import Data.Bits (shiftL, shiftR)
import Data.Binary.Get (getByteString, getWord32le, getWord64be,
getWord64le)
import Data.Binary.Put (putByteString, putWord32le, putWord64be,
putWord64le)
import qualified Data.Bitcoin.Script as Btc (Script (..))
import Data.Bitcoin.Types (VarInt (..))
data TxnOutputType = TxnPubKey
| TxnPubKeyHash
| TxnScriptHash
| TxnMultisig
deriving ( Show, Read, Ord, Eq )
data TransactionHash = TransactionHash Integer
deriving ( Show, Read, Eq )
instance Binary TransactionHash where
get = do
a <- fromIntegral <$> getWord64be
b <- fromIntegral <$> getWord64be
c <- fromIntegral <$> getWord64be
d <- fromIntegral <$> getWord64be
return $ TransactionHash ((a `shiftL` 192) + (b `shiftL` 128) + (c `shiftL` 64) + d)
put (TransactionHash i) = do
putWord64be $ fromIntegral (i `shiftR` 192)
putWord64be $ fromIntegral (i `shiftR` 128)
putWord64be $ fromIntegral (i `shiftR` 64)
putWord64be $ fromIntegral i
data OutPoint = OutPoint {
_outPointHash :: TransactionHash,
_outPointIndex :: Word32
} deriving (Read, Show, Eq)
makeLenses ''OutPoint
instance Binary OutPoint where
get = do
(h,i) <- liftM2 (,) get getWord32le
return $ OutPoint h i
put (OutPoint h i) = put h >> putWord32le i
data TransactionIn = TransactionIn {
_prevOutput :: OutPoint,
_scriptInput :: Btc.Script,
_txInSequence :: Word32
} deriving (Eq, Show, Read)
makeLenses ''TransactionIn
instance Binary TransactionIn where
get = do
o <- get
(VarInt len) <- get
scriptBs <- getByteString (fromIntegral len)
s <- getWord32le
let i = decode $ BSL.fromStrict scriptBs
return $ TransactionIn o i s
put (TransactionIn o i s) = do
let scriptBs = BSL.toStrict $ encode i
put o
put $ VarInt $ fromIntegral $ BS.length scriptBs
putByteString scriptBs
putWord32le s
data TransactionOut = TransactionOut {
_outValue :: Word64,
_scriptOutput :: Btc.Script
} deriving (Eq, Show, Read)
makeLenses ''TransactionOut
instance Binary TransactionOut where
get = do
val <- getWord64le
(VarInt len) <- get
scriptBs <- getByteString (fromIntegral len)
let s = decode $ BSL.fromStrict scriptBs
return $ TransactionOut val s
put (TransactionOut o s) = do
let scriptBs = BSL.toStrict $ encode s
putWord64le o
put $ VarInt $ fromIntegral $ BS.length scriptBs
putByteString scriptBs
data Transaction = Transaction {
_txVersion :: Word32,
_txIn :: [TransactionIn],
_txOut :: [TransactionOut],
_txLockTime :: Word32
} deriving (Eq, Show, Read)
makeLenses ''Transaction
instance Binary Transaction where
get = Transaction <$> getWord32le
<*> (replicateList =<< get)
<*> (replicateList =<< get)
<*> getWord32le
where
replicateList (VarInt c) = replicateM (fromIntegral c) get
put (Transaction v is os l) = do
putWord32le v
put $ VarInt $ fromIntegral $ length is
forM_ is put
put $ VarInt $ fromIntegral $ length os
forM_ os put
putWord32le l
data Coinbase = Coinbase {
_cbVersion :: Word32,
_cbPrevOutput :: OutPoint,
_cbData :: BS.ByteString,
_cbInSequence :: Word32,
_cbOut :: [TransactionOut],
_cbLockTime :: Word32
} deriving (Eq, Show, Read)
makeLenses ''Coinbase
instance Binary Coinbase where
get = do
v <- getWord32le
(VarInt len) <- get
unless (len == 1) $ fail "Coinbase get: Input size is not 1"
op <- get
(VarInt cbLen) <- get
cb <- getByteString (fromIntegral cbLen)
sq <- getWord32le
(VarInt oLen) <- get
os <- replicateM (fromIntegral oLen) get
lt <- getWord32le
return $ Coinbase v op cb sq os lt
put (Coinbase v op cb sq os lt) = do
putWord32le v
put $ VarInt 1
put op
put $ VarInt $ fromIntegral $ BS.length cb
putByteString cb
putWord32le sq
put $ VarInt $ fromIntegral $ length os
forM_ os put
putWord32le lt