module Network.Bitcoin.Transaction.Types where
import Control.Applicative ((<$>),(<*>))
import Control.Monad (liftM2, replicateM, forM_)
import Data.Word ( Word32
, Word64 )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Bits (shiftL, shiftR)
import Data.Binary ( Binary, get, put, encode, decode )
import Data.Binary.Get ( getByteString
, getWord8
, getWord16le
, getWord32le
, getWord64le
, getWord64be )
import Data.Binary.Put ( putByteString
, putWord8
, putWord16le
, putWord32le
, putWord64le
, putWord64be )
import qualified Network.Bitcoin.Script as Btc ( Script (..) )
newtype VarInt = VarInt { getVarInt :: Word64 }
deriving (Eq, Show, Read)
instance Binary VarInt where
get = VarInt <$> ( getWord8 >>= go )
where
go 0xff = getWord64le
go 0xfe = fromIntegral <$> getWord32le
go 0xfd = fromIntegral <$> getWord16le
go x = fromIntegral <$> return x
put (VarInt x)
| x < 0xfd =
putWord8 $ fromIntegral x
| x <= 0xffff = do
putWord8 0xfd
putWord16le $ fromIntegral x
| x <= 0xffffffff = do
putWord8 0xfe
putWord32le $ fromIntegral x
| otherwise = do
putWord8 0xff
putWord64le x
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)
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)
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)
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)
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