{-# LANGUAGE TypeFamilies #-} module Network.EasyBitcoin.Internal.Transaction where import Network.EasyBitcoin.Internal.Words import Network.EasyBitcoin.Internal.Base58 ( encodeBase58 , decodeBase58 , addRedundancy , liftRedundacy ) import Network.EasyBitcoin.Internal.ByteString import Network.EasyBitcoin.Internal.InstanciationHelpers import Network.EasyBitcoin.Internal.Signatures import Network.EasyBitcoin.Keys import Network.EasyBitcoin.BitcoinUnits import Network.EasyBitcoin.Address import Network.EasyBitcoin.Internal.Script import Network.EasyBitcoin.Internal.InstanciationHelpers import Network.EasyBitcoin.Internal.HashFunctions import Data.Bits (testBit, clearBit, setBit) import Control.Applicative import Control.Monad(replicateM,forM_) import qualified Data.ByteString as BS import Data.Char import Data.Binary import Data.Binary.Get ( getWord64be , getWord32be , getWord64le , getWord8 , getWord16le , getWord32le , getByteString , Get ) import Data.Binary.Put( putWord64be , putWord32be , putWord32le , putWord64le , putWord16le , putWord8 , putByteString ) import Data.Maybe(fromMaybe) -------------------------------------------------------------------------------- -- | Bitcoin transaction. -- When parsed, only syntax validation is performanced, particulary, signature validation is not. data Tx net = Tx { txVersion :: Int -- !Word32 , txIn :: [TxIn] , txOut :: [TxOut] , txLockTime :: Int -- Either a b -- Word32 } deriving (Eq) data TxIn = TxIn { prevOutput :: Outpoint -- ^ Reference the previous transaction output (hash + position) , scriptInput :: Script , txInSequence :: Int } deriving (Show,Eq) data TxOut = TxOut { outValue :: Int -- Word64 -- change to ¿BTC? , scriptOutput :: Script } deriving (Show,Eq) instance Binary (Tx net) where get = Tx <$> (fmap fromIntegral getWord32le) <*> (replicateList =<< get) <*> (replicateList =<< get) <*> (fmap fromIntegral getWord32le) where replicateList (VarInt c) = replicateM (fromIntegral c) get put (Tx v is os l) = do putWord32le (fromIntegral v) put $ VarInt $ fromIntegral $ length is forM_ is put put $ VarInt $ fromIntegral $ length os forM_ os put putWord32le (fromIntegral l) instance Binary TxOut where get = do val <- getWord64le VarInt len <- get raw_script <- getByteString $ fromIntegral len case decodeToMaybe raw_script of Just script -> return$TxOut (fromIntegral val) script _ -> fail "could not decode the pub-script" put (TxOut o s) = do putWord64le (fromIntegral o) let s_ = encode' s put $ VarInt $ BS.length s_ putByteString s_ instance Binary TxIn where get = do outpoint <- get VarInt len <- get raw_script <- getByteString $ fromIntegral len val <- getWord32le case decodeToMaybe raw_script of Just script -> return$TxIn outpoint script (fromIntegral val) _ -> fail "could not decode the sig-script" put (TxIn o s q) = do put o let s_ = encode' s put $ VarInt $ BS.length s_ putByteString s_ putWord32le (fromIntegral q) -- | Represents a reference to a transaction output, that is, a transaction hash ('Txid') plus the output position -- within the output vector of the referenced transaction. data Outpoint = Outpoint Txid Int deriving (Eq,Show,Ord,Read) -- | A transaction identification as a hash of the transaction. 2 transaction are consider different if they have different -- 'Txid's. In some cases, it might be possible for a peer to modify a transaction into an equivalent one having a different -- 'Txid', for futher info read about the "transaction-malleability-issue". -------------------------------------------------------------------------------------------------------------------------------------- -- | A transaction hash used to indentify a transaction. Notice that due to the "transaction-malleability-issue", it is possible for an adversary, -- to derivated a new equivalent transaction with a different Txid. data Txid = Txid{ txidHash :: Word256} deriving (Eq,Ord) -- | Compute the 'Txid' of a given transaction. txid:: Tx net -> Txid txid = Txid . fromIntegral . doubleHash256 . encode' instance Show (Txid) where show (Txid x) = bsToHex . BS.reverse $ encode' x instance Read Txid where readsPrec _ str = case readsPrec__ str of ( Just result, rest) -> [(result,rest)] _ -> [] where readsPrec__ str = let (word , rest) = span (not.isSpace)$ dropWhile isSpace str in (fmap Txid . decodeToMaybe . BS.reverse =<< hexToBS word ,rest) instance Binary Txid where get = Txid <$> get put = put . txidHash instance Binary Outpoint where get = Outpoint <$> get <*> (fromIntegral<$>getWord32le) put (Outpoint h i) = put h >> putWord32le (fromIntegral i) instance Show (Tx net) where show = showAsBinary instance Read (Tx net) where readsPrec = readsPrecAsBinary --------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------- --------------------------------------------------------------------------------- -- Todo, create here the function "signatureOfTransaction..." so it does not need to export txSigHash txSigHash :: Tx net -- ^ Transaction to sign. -> Script -- ^ Output script that is being spent. -> Int -- ^ Index of the input that is being signed. -> SigHash -- ^ What parts of the transaction should be signed. -> Word256 -- ^ Result hash to be signed. txSigHash tx out i sh = do let newIn = buildInputs (txIn tx) out i sh fromMaybe (setBit 0 248) -- When SigSingle and input index > outputs, then sign integer 1 $ do newOut <- buildOutputs (txOut tx) i sh let newTx = tx{ txIn = newIn, txOut = newOut } return $ doubleHash256 $ encode' newTx `BS.append` encodeSigHash32 sh -- error $ (bsToHex $ encode' newTx) -- `BS.append` encodeSigHash32 sh) -- ++ " ------------------------ " ++ -- (bsToHex.encode'.doubleHash256 $ encode' newTx `BS.append` encodeSigHash32 sh) -- Builds transaction inputs for computing SigHashes buildInputs :: [TxIn] -> Script -> Int -> SigHash -> [TxIn] buildInputs txins out i sh | anyoneCanPay sh = [ (txins !! i) { scriptInput = out } ] | isSigAll sh || isSigUnknown sh = single | otherwise = map noSeq $ zip single [0..] where empty = map (\ti -> ti{ scriptInput = Script [] }) txins single = updateIndex i empty $ \ti -> ti{ scriptInput = out } noSeq (ti,j) | i == j = ti | otherwise = ti{ txInSequence = 0 } -- Build transaction outputs for computing SigHashes buildOutputs :: [TxOut] -> Int -> SigHash -> Maybe [TxOut] buildOutputs txos i sh | isSigAll sh || isSigUnknown sh = return txos | isSigNone sh = return [] | i >= length txos = Nothing | otherwise = return $ buffer ++ [txos !! i] where buffer = replicate i $ TxOut (-1) (Script []) updateIndex::Int -> [a] -> (a->a) -> [a] updateIndex i xs f | i < 0 || i >= length xs = xs | otherwise = l ++ (f h : r) where (l,h:r) = splitAt i xs -- | Encodes a 'SigHash' to a 32 bit-long bytestring. encodeSigHash32 :: SigHash -> BS.ByteString encodeSigHash32 sh = encode' sh `BS.append` BS.pack [0,0,0] ------------------------------------------------------------------------------------------------------ -- | A SigHash stands for Signature Hash Type, and it describes what parts of the transaction shall be signed. -- data SigHash = SigAll { anyoneCanPay :: !Bool } | SigNone { anyoneCanPay :: !Bool } | SigSingle { anyoneCanPay :: !Bool } | SigUnknown { anyoneCanPay :: !Bool , getSigCode :: !Word8 } deriving (Eq, Show, Read) -- | A 'TxSignature' is a combination of a ecdsa signature and the 'SigHash' used while signing. data TxSignature = TxSignature { txSignature :: !Signature , sigHashType :: !SigHash } deriving (Eq, Show, Read) instance Binary TxSignature where put (TxSignature sig sh) = put sig >> put sh get = TxSignature <$> get <*> get instance Binary SigHash where get = do w <- getWord8 let acp = testBit w 7 return $ case clearBit w 7 of 1 -> SigAll acp 2 -> SigNone acp 3 -> SigSingle acp _ -> SigUnknown acp w put sh = putWord8 $ case sh of SigAll acp | acp -> 0x81 | otherwise -> 0x01 SigNone acp | acp -> 0x82 | otherwise -> 0x02 SigSingle acp | acp -> 0x83 | otherwise -> 0x03 SigUnknown _ w -> w ------------------------------------------------------------------------------------------------------- -- Returns True if the 'SigHash' has the value SigAll. isSigAll :: SigHash -> Bool isSigAll sh = case sh of SigAll _ -> True _ -> False -- Returns True if the 'SigHash' has the value SigNone. isSigNone :: SigHash -> Bool isSigNone sh = case sh of SigNone _ -> True _ -> False -- Returns True if the 'SigHash' has the value SigSingle. isSigSingle :: SigHash -> Bool isSigSingle sh = case sh of SigSingle _ -> True _ -> False -- Returns True if the 'SigHash' has the value SigUnknown. isSigUnknown :: SigHash -> Bool isSigUnknown sh = case sh of SigUnknown _ _ -> True _ -> False