haskoin-protocol (empty) → 0.0.1
raw patch · 28 files changed
+1848/−0 lines, 28 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, binary, bytestring, haskoin-crypto, haskoin-util, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- Network/Haskoin/Protocol.hs +83/−0
- Network/Haskoin/Protocol/Addr.hs +39/−0
- Network/Haskoin/Protocol/Alert.hs +21/−0
- Network/Haskoin/Protocol/Arbitrary.hs +195/−0
- Network/Haskoin/Protocol/Block.hs +38/−0
- Network/Haskoin/Protocol/BlockHeader.hs +55/−0
- Network/Haskoin/Protocol/GetBlocks.hs +53/−0
- Network/Haskoin/Protocol/GetData.hs +34/−0
- Network/Haskoin/Protocol/GetHeaders.hs +47/−0
- Network/Haskoin/Protocol/Headers.hs +36/−0
- Network/Haskoin/Protocol/Inv.hs +29/−0
- Network/Haskoin/Protocol/InvVector.hs +51/−0
- Network/Haskoin/Protocol/Message.hs +114/−0
- Network/Haskoin/Protocol/MessageHeader.hs +125/−0
- Network/Haskoin/Protocol/NetworkAddress.hs +45/−0
- Network/Haskoin/Protocol/NotFound.hs +30/−0
- Network/Haskoin/Protocol/Ping.hs +37/−0
- Network/Haskoin/Protocol/Script.hs +257/−0
- Network/Haskoin/Protocol/Tx.hs +189/−0
- Network/Haskoin/Protocol/VarInt.hs +46/−0
- Network/Haskoin/Protocol/VarString.hs +29/−0
- Network/Haskoin/Protocol/Version.hs +85/−0
- Setup.hs +2/−0
- UNLICENSE +24/−0
- haskoin-protocol.cabal +71/−0
- tests/Main.hs +13/−0
- tests/Network/Haskoin/Protocol/Tests.hs +56/−0
- tests/Units.hs +44/−0
+ Network/Haskoin/Protocol.hs view
@@ -0,0 +1,83 @@+{-|+ This package provides all of the basic types used for the Bitcoin + networking protocol together with Data.Binary instances for efficiently+ serializing and de-serializing them. More information on the bitcoin protocol+ is available here: <http://en.bitcoin.it/wiki/Protocol_specification>+-}+module Network.Haskoin.Protocol+( + -- * Blocks+ Block(..)+, GetBlocks(..)++ -- * Block Headers+, BlockHeader(..)+, GetHeaders(..)+, Headers(..)+, BlockHeaderCount++ -- * Requesting data+, GetData(..)+, Inv(..)+, InvVector(..)+, InvType(..)+, NotFound(..)++ -- *Scripts+ -- | More informations on scripts is available here:+ -- <http://en.bitcoin.it/wiki/Script>+, Script(..)+, ScriptOp(..)+, getScriptOps+, putScriptOps+, decodeScriptOps+, encodeScriptOps++ -- *Transactions+, Tx(..)+, txid+, CoinbaseTx(..)+, TxIn(..)+, TxOut(..)+, OutPoint(..)+, encodeTxid+, decodeTxid++ -- * Network types+, VarInt(..)+, VarString(..)+, NetworkAddress(..)+, Addr(..)+, NetworkAddressTime+, Version(..)+, Ping(..)+, Pong(..)+, Alert(..)++ -- *Messages+, Message(..)+, MessageHeader(..)+, MessageCommand(..)+) where++import Network.Haskoin.Protocol.Message+import Network.Haskoin.Protocol.Addr+import Network.Haskoin.Protocol.Alert+import Network.Haskoin.Protocol.BlockHeader+import Network.Haskoin.Protocol.Block+import Network.Haskoin.Protocol.GetBlocks+import Network.Haskoin.Protocol.GetData+import Network.Haskoin.Protocol.GetHeaders+import Network.Haskoin.Protocol.Headers+import Network.Haskoin.Protocol.Inv+import Network.Haskoin.Protocol.InvVector+import Network.Haskoin.Protocol.MessageHeader+import Network.Haskoin.Protocol.NetworkAddress+import Network.Haskoin.Protocol.NotFound+import Network.Haskoin.Protocol.Ping+import Network.Haskoin.Protocol.Script+import Network.Haskoin.Protocol.Tx+import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.VarString+import Network.Haskoin.Protocol.Version+
+ Network/Haskoin/Protocol/Addr.hs view
@@ -0,0 +1,39 @@+module Network.Haskoin.Protocol.Addr +( Addr(..)+, NetworkAddressTime +) where++import Control.Monad (liftM2, replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Word (Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.NetworkAddress++-- | Network address with a timestamp+type NetworkAddressTime = (Word32, NetworkAddress)++-- | Provides information on known nodes in the bitcoin network. An 'Addr'+-- type is sent inside a 'Message' as a response to a 'GetAddr' message.+data Addr = + Addr { + -- List of addresses of other nodes on the network with timestamps.+ addrList :: ![NetworkAddressTime] + } + deriving (Eq, Show)++instance Binary Addr where++ get = Addr <$> (repList =<< get)+ where + repList (VarInt c) = replicateM (fromIntegral c) action+ action = liftM2 (,) getWord32le get ++ put (Addr xs) = do+ put $ VarInt $ fromIntegral $ length xs+ forM_ xs $ \(a,b) -> (putWord32le a) >> (put b)+
+ Network/Haskoin/Protocol/Alert.hs view
@@ -0,0 +1,21 @@+module Network.Haskoin.Protocol.Alert ( Alert(..) ) where++import Control.Applicative ((<$>),(<*>))+import Data.Binary (Binary, get, put)+import Network.Haskoin.Protocol.VarString++-- | Data type describing signed messages that can be sent between bitcoin+-- nodes to display important notifications to end users about the health of+-- the network.+data Alert = + Alert {+ -- | Alert payload. + alertPayload :: !VarString+ -- | ECDSA signature of the payload+ , alertSignature :: !VarString+ } deriving (Eq, Show)++instance Binary Alert where+ get = Alert <$> get <*> get+ put (Alert p s) = put p >> put s+
+ Network/Haskoin/Protocol/Arbitrary.hs view
@@ -0,0 +1,195 @@+{-|+ This package provides QuickCheck Arbitrary instances for all the protocol+ data types defined in 'Network.Haskoin.Protocol'.+-}+module Network.Haskoin.Protocol.Arbitrary () where++import Test.QuickCheck+import Network.Haskoin.Util.Arbitrary (nonEmptyBS)+import Network.Haskoin.Crypto.Arbitrary()++import Control.Monad+import Control.Applicative ++import Network.Haskoin.Protocol+import Network.Haskoin.Crypto++instance Arbitrary VarInt where+ arbitrary = VarInt <$> arbitrary++instance Arbitrary VarString where+ arbitrary = VarString <$> arbitrary++instance Arbitrary NetworkAddress where+ arbitrary = do+ s <- arbitrary+ a <- liftM2 (,) arbitrary arbitrary+ p <- arbitrary+ return $ NetworkAddress s a p++instance Arbitrary InvType where+ arbitrary = elements [InvError, InvTx, InvBlock]++instance Arbitrary InvVector where+ arbitrary = InvVector <$> arbitrary <*> (hash256 <$> arbitrary)++instance Arbitrary Inv where+ arbitrary = Inv <$> listOf arbitrary++instance Arbitrary Version where+ arbitrary = Version <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Addr where+ arbitrary = Addr <$> listOf arbitrary++instance Arbitrary Alert where+ arbitrary = Alert <$> arbitrary <*> arbitrary++instance Arbitrary BlockHeader where+ arbitrary = BlockHeader <$> arbitrary+ <*> (hash256 <$> arbitrary)+ <*> (hash256 <$> arbitrary)+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ +instance Arbitrary Script where+ arbitrary = do+ i <- choose (1,10)+ Script <$> (vectorOf i arbitrary)++instance Arbitrary Tx where+ arbitrary = do+ v <- arbitrary+ tin <- do + l <- choose (0,10)+ vectorOf l arbitrary+ tout <- do+ l <- choose (0,10)+ vectorOf l arbitrary+ t <- arbitrary+ return $ Tx v tin tout t++instance Arbitrary CoinbaseTx where+ arbitrary = CoinbaseTx <$> arbitrary+ <*> arbitrary+ <*> (listOf arbitrary)+ <*> arbitrary++instance Arbitrary TxIn where+ arbitrary = TxIn <$> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary TxOut where+ arbitrary = TxOut <$> (choose (0,2100000000000000))+ <*> arbitrary++instance Arbitrary OutPoint where+ arbitrary = OutPoint <$> arbitrary+ <*> (choose (0,2147483647))++instance Arbitrary Block where+ arbitrary = do+ h <- arbitrary+ c <- arbitrary+ t <- do + l <- choose (0,10)+ vectorOf l arbitrary+ return $ Block h c t++instance Arbitrary ScriptOp where+ arbitrary = oneof [ OP_PUSHDATA <$> nonEmptyBS+ , return OP_0+ , return OP_1NEGATE+ , return OP_1+ , return OP_2, return OP_3, return OP_4, return OP_5+ , return OP_6, return OP_7, return OP_8, return OP_9+ , return OP_10, return OP_11, return OP_12, return OP_13+ , return OP_14, return OP_15, return OP_16+ , return OP_VERIFY+ , return OP_DUP+ , return OP_EQUAL+ , return OP_EQUALVERIFY+ , return OP_HASH160+ , return OP_CHECKSIG+ , return OP_CHECKMULTISIG+ , OP_PUBKEY <$> arbitrary+ , return $ OP_INVALIDOPCODE 0xff+ ]++instance Arbitrary GetBlocks where+ arbitrary = GetBlocks <$> arbitrary+ <*> (listOf arbitrary)+ <*> arbitrary++instance Arbitrary GetData where+ arbitrary = GetData <$> (listOf arbitrary)++instance Arbitrary GetHeaders where+ arbitrary = GetHeaders <$> arbitrary+ <*> (listOf arbitrary)+ <*> arbitrary++instance Arbitrary Headers where+ arbitrary = Headers <$> (listOf (liftM2 (,) arbitrary arbitrary))++instance Arbitrary NotFound where+ arbitrary = NotFound <$> (listOf arbitrary)++instance Arbitrary Ping where+ arbitrary = Ping <$> arbitrary++instance Arbitrary Pong where+ arbitrary = Pong <$> arbitrary++instance Arbitrary MessageCommand where+ arbitrary = elements [ MCVersion+ , MCVerAck+ , MCAddr+ , MCInv+ , MCGetData+ , MCNotFound+ , MCGetBlocks+ , MCGetHeaders+ , MCTx+ , MCBlock+ , MCHeaders+ , MCGetAddr+ , MCPing+ , MCPong+ , MCAlert+ ]++instance Arbitrary MessageHeader where+ arbitrary = MessageHeader <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Message where+ arbitrary = oneof [ MVersion <$> arbitrary+ , return MVerAck+ , MAddr <$> arbitrary+ , MInv <$> arbitrary+ , MGetData <$> arbitrary+ , MNotFound <$> arbitrary+ , MGetBlocks <$> arbitrary+ , MGetHeaders <$> arbitrary+ , MTx <$> arbitrary+ , MBlock <$> arbitrary+ , MHeaders <$> arbitrary+ , return MGetAddr+ , MPing <$> arbitrary+ , MPong <$> arbitrary+ , MAlert <$> arbitrary+ ]+
+ Network/Haskoin/Protocol/Block.hs view
@@ -0,0 +1,38 @@+module Network.Haskoin.Protocol.Block ( Block(..) ) where++import Control.Monad (replicateM, forM_)++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.Tx+import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.BlockHeader++-- | Data type describing a block in the bitcoin protocol. Blocks are sent in+-- response to 'GetData' messages that are requesting information from a+-- block hash.+data Block = + Block {+ -- | Header information for this block+ blockHeader :: !BlockHeader+ -- | Coinbase transaction of this block+ , blockCoinbaseTx :: !CoinbaseTx+ -- | List of transactions pertaining to this block+ , blockTxns :: ![Tx]+ } deriving (Eq, Show)++instance Binary Block where++ get = do+ header <- get+ (VarInt c) <- get+ cb <- get+ txs <- replicateM (fromIntegral (c-1)) get+ return $ Block header cb txs++ put (Block h cb txs) = do+ put h+ put $ VarInt $ fromIntegral $ (length txs) + 1+ put cb+ forM_ txs put+
+ Network/Haskoin/Protocol/BlockHeader.hs view
@@ -0,0 +1,55 @@+module Network.Haskoin.Protocol.BlockHeader ( BlockHeader(..) ) where++import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Crypto (Hash256)++-- | Data type recording information on a 'Block'. The hash of a block is+-- defined as the hash of this data structure. The block mining process+-- involves finding a partial hash collision by varying the nonce in the+-- 'BlockHeader' and/or additional randomness in the 'CoinbaseTx' of this+-- 'Block'. Variations in the 'CoinbaseTx' will result in different merkle +-- roots in the 'BlockHeader'.+data BlockHeader = + BlockHeader {+ -- | Block version information, based on the version of the+ -- software creating this block.+ blockVersion :: !Word32+ -- | Hash of the previous block (parent) referenced by this+ -- block.+ , prevBlock :: !Hash256+ -- | Root of the merkle tree of all transactions pertaining+ -- to this block.+ , merkleRoot :: !Hash256+ -- | Unix timestamp recording when this block was created+ , blockTimestamp :: !Word32+ -- | The difficulty target being used for this block+ , blockBits :: !Word32+ -- | A random nonce used to generate this block. Additional+ -- randomness is included in the coinbase transaction of+ -- this block.+ , bhNonce :: !Word32+ } deriving (Eq, Show)++instance Binary BlockHeader where++ get = BlockHeader <$> getWord32le+ <*> get+ <*> get+ <*> getWord32le+ <*> getWord32le+ <*> getWord32le++ put (BlockHeader v p m bt bb n) = do+ putWord32le v+ put p+ put m+ putWord32le bt+ putWord32le bb+ putWord32le n +
+ Network/Haskoin/Protocol/GetBlocks.hs view
@@ -0,0 +1,53 @@+module Network.Haskoin.Protocol.GetBlocks +( GetBlocks(..) +, BlockLocator+) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Crypto (Hash256)++type BlockLocator = [Hash256]++-- | Data type representing a GetBlocks message request. It is used in the+-- bitcoin protocol to retrieve blocks from a peer by providing it a+-- 'BlockLocator' object. The 'BlockLocator' is a sparse list of block hashes+-- from the caller node with the purpose of informing the receiving node+-- about the state of the caller's blockchain. The receiver node will detect+-- a wrong branch in the caller's main chain and send the caller appropriate +-- 'Blocks'. The response to a 'GetBlocks' message is an 'Inv' message+-- containing the list of block hashes pertaining to the request. +data GetBlocks = + GetBlocks {+ -- | The protocol version+ getBlocksVersion :: !Word32+ -- | Block locator object. It is a list of block hashes from the+ -- most recent block back to the genesis block. The list is+ -- dense at first and sparse towards the end.+ , getBlocksLocator :: !BlockLocator+ -- | Hash of the last desired block. If set to zero, the+ -- maximum number of block hashes is returned (500).+ , getBlocksHashStop :: !Hash256+ } deriving (Eq, Show)++instance Binary GetBlocks where++ get = GetBlocks <$> getWord32le+ <*> (repList =<< get)+ <*> get+ where + repList (VarInt c) = replicateM (fromIntegral c) get++ put (GetBlocks v xs h) = do+ putWord32le v+ put $ VarInt $ fromIntegral $ length xs+ forM_ xs put+ put h+
+ Network/Haskoin/Protocol/GetData.hs view
@@ -0,0 +1,34 @@+module Network.Haskoin.Protocol.GetData ( GetData(..) ) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.InvVector+import Network.Haskoin.Protocol.VarInt++-- | The 'GetData' type is used to retrieve information on a specific object+-- ('Block' or 'Tx') identified by the objects hash. The payload of a 'GetData'+-- request is a list of 'InvVector' which represent all the hashes for which a+-- node wants to request information. The response to a 'GetBlock' message+-- wille be either a 'Block' or a 'Tx' message depending on the type of the+-- object referenced by the hash. Usually, 'GetData' messages are sent after a+-- node receives an 'Inv' message to obtain information on unknown object+-- hashes. +data GetData = + GetData {+ -- | List of object hashes + getDataList :: ![InvVector] + } deriving (Eq, Show)++instance Binary GetData where++ get = GetData <$> (repList =<< get)+ where + repList (VarInt c) = replicateM (fromIntegral c) get++ put (GetData xs) = do+ put $ VarInt $ fromIntegral $ length xs+ forM_ xs put+
+ Network/Haskoin/Protocol/GetHeaders.hs view
@@ -0,0 +1,47 @@+module Network.Haskoin.Protocol.GetHeaders ( GetHeaders(..) ) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.GetBlocks (BlockLocator)++import Network.Haskoin.Crypto (Hash256)++-- | Similar to the 'GetBlocks' message type but for retrieving block headers+-- only. The response to a 'GetHeaders' request is a 'Headers' message+-- containing a list of block headers pertaining to the request. A maximum of+-- 2000 block headers can be returned. 'GetHeaders' is used by thin (SPV)+-- clients to exclude block contents when synchronizing the blockchain.+data GetHeaders = + GetHeaders {+ -- | The protocol version+ getHeadersVersion :: !Word32+ -- | Block locator object. It is a list of block hashes from+ -- the most recent block back to the Genesis block. The list+ -- is dense at first and sparse towards the end.+ , getHeadersBL :: !BlockLocator+ -- | Hash of the last desired block header. When set to zero,+ -- the maximum number of block headers is returned (2000)+ , getHeadersHashStop :: !Hash256+ } deriving (Eq, Show)++instance Binary GetHeaders where++ get = GetHeaders <$> getWord32le+ <*> (repList =<< get)+ <*> get+ where + repList (VarInt c) = replicateM (fromIntegral c) get++ put (GetHeaders v xs h) = do+ putWord32le v+ put $ VarInt $ fromIntegral $ length xs+ forM_ xs put+ put h+
+ Network/Haskoin/Protocol/Headers.hs view
@@ -0,0 +1,36 @@+module Network.Haskoin.Protocol.Headers +( Headers(..)+, BlockHeaderCount+) where++import Control.Monad (liftM2, replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.BlockHeader++-- | 'BlockHeader' type with a transaction count as 'VarInt'+type BlockHeaderCount = (BlockHeader, VarInt)++-- | The 'Headers' type is used to return a list of block headers in+-- response to a 'GetHeaders' message.+data Headers = + Headers { + -- | List of block headers with respective transaction counts+ headersList :: ![BlockHeaderCount] + } + deriving (Eq, Show)++instance Binary Headers where++ get = Headers <$> (repList =<< get)+ where + repList (VarInt c) = replicateM (fromIntegral c) action+ action = liftM2 (,) get get++ put (Headers xs) = do+ put $ VarInt $ fromIntegral $ length xs+ forM_ xs $ \(a,b) -> put a >> put b+
+ Network/Haskoin/Protocol/Inv.hs view
@@ -0,0 +1,29 @@+module Network.Haskoin.Protocol.Inv ( Inv(..) ) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.InvVector+import Network.Haskoin.Protocol.VarInt++-- | 'Inv' messages are used by nodes to advertise their knowledge of new+-- objects by publishing a list of hashes. 'Inv' messages can be sent+-- unsolicited or in response to a 'GetBlocks' message.+data Inv = + Inv { + -- | Inventory vectors+ invList :: ![InvVector] + } deriving (Eq, Show)++instance Binary Inv where++ get = Inv <$> (repList =<< get)+ where + repList (VarInt c) = replicateM (fromIntegral c) get++ put (Inv xs) = do+ put $ VarInt $ fromIntegral $ length xs+ forM_ xs put+
+ Network/Haskoin/Protocol/InvVector.hs view
@@ -0,0 +1,51 @@+module Network.Haskoin.Protocol.InvVector +( InvVector(..) +, InvType(..)+) where++import Control.Applicative ((<$>),(<*>))++import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Crypto (Hash256)++-- | Data type identifying the type of an inventory vector. +data InvType + = InvError -- ^ Error. Data containing this type can be ignored.+ | InvTx -- ^ InvVector hash is related to a transaction + | InvBlock -- ^ InvVector hash is related to a block+ deriving (Eq, Show)++instance Binary InvType where++ get = go =<< getWord32le+ where + go x = case x of+ 0 -> return InvError+ 1 -> return InvTx+ 2 -> return InvBlock+ _ -> fail "bitcoinGet InvType: Invalid Type"++ put x = putWord32le $ case x of+ InvError -> 0+ InvTx -> 1+ InvBlock -> 2++-- | Invectory vectors represent hashes identifying objects such as a 'Block'+-- or a 'Tx'. They are sent inside messages to notify other peers about +-- new data or data they have requested.+data InvVector = + InvVector {+ -- | Type of the object referenced by this inventory vector+ invType :: !InvType+ -- | Hash of the object referenced by this inventory vector+ , invHash :: !Hash256+ } deriving (Eq, Show)++instance Binary InvVector where+ get = InvVector <$> get <*> get+ put (InvVector t h) = put t >> put h++
+ Network/Haskoin/Protocol/Message.hs view
@@ -0,0 +1,114 @@+module Network.Haskoin.Protocol.Message ( Message(..) ) where++import Control.Monad (unless)+import Control.Applicative ((<$>))++import Data.Word (Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get + ( lookAhead+ , getByteString+ )+import Data.Binary.Put (putByteString)+import qualified Data.ByteString as BS + ( length + , append+ , empty+ )++import Network.Haskoin.Protocol.MessageHeader+import Network.Haskoin.Protocol.Version+import Network.Haskoin.Protocol.Addr+import Network.Haskoin.Protocol.Inv+import Network.Haskoin.Protocol.GetData+import Network.Haskoin.Protocol.NotFound+import Network.Haskoin.Protocol.GetBlocks+import Network.Haskoin.Protocol.GetHeaders+import Network.Haskoin.Protocol.Tx+import Network.Haskoin.Protocol.Block+import Network.Haskoin.Protocol.Headers+import Network.Haskoin.Protocol.Ping+import Network.Haskoin.Protocol.Alert++import Network.Haskoin.Util (isolate, encode')+import Network.Haskoin.Crypto (chksum32)++networkMagic :: Word32+networkMagic = 0xf9beb4d9++-- | The 'Message' type is used to identify all the valid messages that can be+-- sent between bitcoin peers. Only values of type 'Message' will be accepted+-- by other bitcoin peers as bitcoin protocol messages need to be correctly+-- serialized with message headers. Serializing a 'Message' value will+-- include the 'MessageHeader' with the correct checksum value automatically.+-- No need to add the 'MessageHeader' separately.+data Message + = MVersion Version + | MVerAck + | MAddr Addr + | MInv Inv + | MGetData GetData + | MNotFound NotFound + | MGetBlocks GetBlocks + | MGetHeaders GetHeaders + | MTx Tx + | MBlock Block + | MHeaders Headers + | MGetAddr + | MPing Ping + | MPong Pong + | MAlert Alert+ deriving (Eq, Show)++instance Binary Message where++ get = do+ (MessageHeader mgc cmd len chk) <- get+ bs <- lookAhead $ getByteString $ fromIntegral len+ unless (mgc == networkMagic)+ (fail $ "get: Invalid network magic bytes: " ++ (show mgc))+ unless (chksum32 bs == chk) + (fail $ "get: Invalid message checksum: " ++ (show chk))+ if len > 0 + then isolate (fromIntegral len) $ case cmd of+ MCVersion -> MVersion <$> get+ MCAddr -> MAddr <$> get+ MCInv -> MInv <$> get+ MCGetData -> MGetData <$> get+ MCNotFound -> MNotFound <$> get+ MCGetBlocks -> MGetBlocks <$> get+ MCGetHeaders -> MGetHeaders <$> get+ MCTx -> MTx <$> get+ MCBlock -> MBlock <$> get+ MCHeaders -> MHeaders <$> get+ MCPing -> MPing <$> get+ MCPong -> MPong <$> get+ MCAlert -> MAlert <$> get+ _ -> fail $ "get: Invalid command " ++ (show cmd)+ else case cmd of+ MCGetAddr -> return MGetAddr + MCVerAck -> return MVerAck+ _ -> fail $ "get: Invalid command " ++ (show cmd)++ put msg = do+ let (cmd, payload) = case msg of+ (MVersion m) -> (MCVersion, encode' m)+ (MVerAck) -> (MCVerAck, BS.empty)+ (MAddr m) -> (MCAddr, encode' m)+ (MInv m) -> (MCInv, encode' m)+ (MGetData m) -> (MCGetData, encode' m)+ (MNotFound m) -> (MCNotFound, encode' m)+ (MGetBlocks m) -> (MCGetBlocks, encode' m)+ (MGetHeaders m) -> (MCGetHeaders, encode' m)+ (MTx m) -> (MCTx, encode' m)+ (MBlock m) -> (MCBlock, encode' m)+ (MHeaders m) -> (MCHeaders, encode' m)+ (MGetAddr) -> (MCGetAddr, BS.empty)+ (MPing m) -> (MCPing, encode' m)+ (MPong m) -> (MCPong, encode' m)+ (MAlert m) -> (MCAlert, encode' m)+ chk = chksum32 payload+ len = fromIntegral $ BS.length payload+ header = MessageHeader networkMagic cmd len chk+ putByteString $ (encode' header) `BS.append` payload+
+ Network/Haskoin/Protocol/MessageHeader.hs view
@@ -0,0 +1,125 @@+module Network.Haskoin.Protocol.MessageHeader + ( MessageHeader(..) + , MessageCommand(..)+ ) where++import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32)+import qualified Data.ByteString as BS + ( ByteString+ , takeWhile+ )+import Data.Binary (Binary, get, put)+import Data.Binary.Get + ( getWord32le+ , getWord32be+ , getByteString+ )+import Data.Binary.Put + ( putWord32le+ , putWord32be+ , putByteString+ )++import Network.Haskoin.Util (stringToBS, bsToString)+import Network.Haskoin.Crypto (CheckSum32)++-- | A 'MessageCommand' is included in a 'MessageHeader' in order to identify+-- the type of message present in the payload. This allows the message +-- de-serialization code to know how to decode a particular message payload.+-- Every valid 'Message' constructor has a corresponding 'MessageCommand'+-- constructor.+data MessageCommand + = MCVersion + | MCVerAck + | MCAddr + | MCInv + | MCGetData + | MCNotFound + | MCGetBlocks + | MCGetHeaders + | MCTx + | MCBlock + | MCHeaders + | MCGetAddr + | MCPing + | MCPong + | MCAlert+ deriving (Eq, Show)++instance Binary MessageCommand where+ + get = go =<< getByteString 12+ where + go bs = case unpackCommand bs of+ "version" -> return MCVersion+ "verack" -> return MCVerAck+ "addr" -> return MCAddr+ "inv" -> return MCInv+ "getdata" -> return MCGetData+ "notfound" -> return MCNotFound+ "getblocks" -> return MCGetBlocks+ "getheaders" -> return MCGetHeaders+ "tx" -> return MCTx+ "block" -> return MCBlock+ "headers" -> return MCHeaders+ "getaddr" -> return MCGetAddr+ "ping" -> return MCPing+ "pong" -> return MCPong+ "alert" -> return MCAlert+ _ -> fail "get MessageCommand : Invalid command"++ put mc = putByteString $ packCommand $ case mc of+ MCVersion -> "version"+ MCVerAck -> "verack"+ MCAddr -> "addr"+ MCInv -> "inv"+ MCGetData -> "getdata"+ MCNotFound -> "notfound"+ MCGetBlocks -> "getblocks"+ MCGetHeaders -> "getheaders"+ MCTx -> "tx"+ MCBlock -> "block"+ MCHeaders -> "headers"+ MCGetAddr -> "getaddr"+ MCPing -> "ping"+ MCPong -> "pong"+ MCAlert -> "alert"++packCommand :: String -> BS.ByteString+packCommand s = stringToBS $ take 12 $ s ++ repeat '\NUL'++unpackCommand :: BS.ByteString -> String+unpackCommand bs = bsToString $ BS.takeWhile (/= 0) bs++-- | Data type representing the header of a 'Message'. All messages sent between+-- nodes contain a message header.+data MessageHeader = + MessageHeader {+ -- | Network magic bytes. It is used to differentiate + -- messages meant for different bitcoin networks, such as+ -- prodnet and testnet.+ headMagic :: !Word32+ -- | Message command identifying the type of message.+ -- included in the payload.+ , headCmd :: !MessageCommand+ -- | Byte length of the payload.+ , headPayloadSize :: !Word32+ -- | Checksum of the payload. + , headChecksum :: !CheckSum32+ } deriving (Eq, Show)++instance Binary MessageHeader where++ get = MessageHeader <$> getWord32be+ <*> get+ <*> getWord32le+ <*> get++ put (MessageHeader m c l chk) = do+ putWord32be m+ put c+ putWord32le l+ put chk+
+ Network/Haskoin/Protocol/NetworkAddress.hs view
@@ -0,0 +1,45 @@+module Network.Haskoin.Protocol.NetworkAddress ( NetworkAddress(..) ) where++import Control.Monad (liftM2)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word16, Word64)+import Data.Binary (Binary, get, put)+import Data.Binary.Get + ( getWord16be+ , getWord64le+ , getWord64be+ )+import Data.Binary.Put+ ( putWord16be+ , putWord64le+ , putWord64be+ )++-- | Data type describing a bitcoin network address. Addresses are stored in+-- IPv6. IPv4 addresses are mapped to IPv6 using IPv4 mapped IPv6 addresses:+-- <http://en.wikipedia.org/wiki/IPv6#IPv4-mapped_IPv6_addresses>. Sometimes,+-- timestamps are sent together with the 'NetworkAddress' such as in the 'Addr'+-- data type.+data NetworkAddress = + NetworkAddress {+ -- | Bitmask of services available for this address+ naServices :: !Word64+ -- | IPv6 address serialized as big endian+ , naAddress :: !(Word64, Word64)+ -- | Port number serialized as big endian+ , naPort :: !Word16+ } deriving (Eq, Show)++instance Binary NetworkAddress where++ get = NetworkAddress <$> getWord64le+ <*> (liftM2 (,) getWord64be getWord64be)+ <*> getWord16be++ put (NetworkAddress s (al,ar) p) = do+ putWord64le s+ putWord64be al+ putWord64be ar+ putWord16be p+
+ Network/Haskoin/Protocol/NotFound.hs view
@@ -0,0 +1,30 @@+module Network.Haskoin.Protocol.NotFound ( NotFound(..) ) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.InvVector++-- | A 'NotFound' message is returned as a response to a 'GetData' message+-- whe one of the requested objects could not be retrieved. This could happen,+-- for example, if a tranasaction was requested and was not available in the+-- memory pool of the receiving node.+data NotFound = + NotFound {+ -- | Inventory vectors related to this request+ notFoundList :: ![InvVector] + } deriving (Eq, Show)++instance Binary NotFound where++ get = NotFound <$> (repList =<< get)+ where + repList (VarInt c) = replicateM (fromIntegral c) get++ put (NotFound xs) = do+ put $ VarInt $ fromIntegral $ length xs+ forM_ xs put+
+ Network/Haskoin/Protocol/Ping.hs view
@@ -0,0 +1,37 @@+module Network.Haskoin.Protocol.Ping+( Ping(..)+, Pong(..)+) where++import Control.Applicative ((<$>))++import Data.Word (Word64)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord64le)+import Data.Binary.Put (putWord64le)++-- | A Ping message is sent to bitcoin peers to check if a TCP\/IP connection+-- is still valid.+newtype Ping = + Ping { + -- | A random nonce used to identify the recipient of the ping+ -- request once a Pong response is received. + pingNonce :: Word64 + } deriving (Eq, Show)++-- | A Pong message is sent as a response to a ping message.+newtype Pong = + Pong { + -- | When responding to a Ping request, the nonce from the Ping+ -- is copied in the Pong response.+ pongNonce :: Word64 + } deriving (Eq, Show)++instance Binary Ping where+ get = Ping <$> getWord64le+ put (Ping n) = putWord64le n++instance Binary Pong where+ get = Pong <$> getWord64le+ put (Pong n) = putWord64le n+
+ Network/Haskoin/Protocol/Script.hs view
@@ -0,0 +1,257 @@+module Network.Haskoin.Protocol.Script +( ScriptOp(..)+, Script(..)+, getScriptOps+, putScriptOps+, decodeScriptOps+, encodeScriptOps+) where++import Control.Monad (liftM2)+import Control.Applicative ((<$>))++import Data.Word (Word8)+import Data.Binary (Binary, get, put)+import Data.Binary.Get + ( Get+ , isEmpty+ , getWord8+ , getWord16le+ , getWord32le+ , getByteString+ )+import Data.Binary.Put + ( Put + , putWord8+ , putWord16le+ , putWord32le+ , putByteString+ )+import qualified Data.ByteString as BS+ ( ByteString+ , length+ )++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Util + ( isolate+ , runPut'+ , encode'+ , bsToHex+ , fromRunGet+ )+import Network.Haskoin.Crypto (PubKey)++-- | Data type representing a transaction script. Scripts are defined as lists+-- of script operators 'ScriptOp'. Scripts are used to:+--+-- * Define the spending conditions in the output of a transaction+--+-- * Provide the spending signatures in the input of a transaction+data Script = + Script { + -- | List of script operators defining this script+ scriptOps :: [ScriptOp] + }+ deriving (Eq, Show)++instance Binary Script where+ get = do+ (VarInt len) <- get+ isolate (fromIntegral len) $ Script <$> getScriptOps++ put (Script ops) = do+ let bs = runPut' $ putScriptOps ops+ put $ VarInt $ fromIntegral $ BS.length bs+ putByteString bs++-- | Deserialize a list of 'ScriptOp' inside the 'Data.Binary.Get' monad.+-- This deserialization does not take into account the length of the script.+getScriptOps :: Get [ScriptOp]+getScriptOps = do+ empty <- isEmpty+ if empty + then return [] + else liftM2 (:) get getScriptOps++-- | Serialize a list of 'ScriptOp' inside the 'Data.Binary.Put' monad.+-- This serialization does not take into account the length of the script.+putScriptOps :: [ScriptOp] -> Put+putScriptOps (x:xs) = put x >> putScriptOps xs+putScriptOps _ = return ()++-- | Decode a 'Script' from a ByteString by omiting the length of the script.+-- This is used to produce scripthash addresses.+decodeScriptOps :: BS.ByteString -> Either String Script+decodeScriptOps bs = fromRunGet getScriptOps bs msg (return . Script)+ where + msg = Left "decodeScriptOps: Could not decode scriptops"++-- | Encode a 'Script' into a ByteString by omiting the length of the script.+-- This is used to produce scripthash addresses.+encodeScriptOps :: Script -> BS.ByteString+encodeScriptOps = runPut' . putScriptOps . scriptOps++-- | Data type representing all of the operators allowed inside a 'Script'.+data ScriptOp + = + -- Pushing Data+ OP_PUSHDATA BS.ByteString + | OP_0 + | OP_1NEGATE + | OP_1 | OP_2 | OP_3 | OP_4 + | OP_5 | OP_6 | OP_7 | OP_8 + | OP_9 | OP_10 | OP_11 | OP_12 + | OP_13 | OP_14 | OP_15 | OP_16 ++ -- Flow control+ | OP_VERIFY ++ -- Stack operations+ | OP_DUP ++ -- Bitwise logic+ | OP_EQUAL + | OP_EQUALVERIFY ++ -- Crypto+ | OP_HASH160 + | OP_CHECKSIG + | OP_CHECKMULTISIG ++ -- Other+ | OP_PUBKEY PubKey + | OP_INVALIDOPCODE Word8+ deriving Eq ++instance Show ScriptOp where+ show op = case op of+ (OP_PUSHDATA bs) -> "OP_PUSHDATA " ++ (show $ bsToHex bs)+ OP_0 -> "OP_0"+ OP_1NEGATE -> "OP_1NEGATE"+ OP_1 -> "OP_1"+ OP_2 -> "OP_2"+ OP_3 -> "OP_3"+ OP_4 -> "OP_4"+ OP_5 -> "OP_5"+ OP_6 -> "OP_6"+ OP_7 -> "OP_7"+ OP_8 -> "OP_8"+ OP_9 -> "OP_9"+ OP_10 -> "OP_10"+ OP_11 -> "OP_11"+ OP_12 -> "OP_12"+ OP_13 -> "OP_13"+ OP_14 -> "OP_14"+ OP_15 -> "OP_15"+ OP_16 -> "OP_16"+ OP_VERIFY -> "OP_VERIFY"+ OP_DUP -> "OP_DUP"+ OP_EQUAL -> "OP_EQUAL"+ OP_EQUALVERIFY -> "OP_EQUALVERIFY"+ OP_HASH160 -> "OP_HASH160"+ OP_CHECKSIG -> "OP_CHECKSIG"+ OP_CHECKMULTISIG -> "OP_CHECKMULTISIG"+ (OP_PUBKEY p) -> "OP_PUBKEY " ++ (show $ bsToHex $ encode' p) + (OP_INVALIDOPCODE w) -> "OP_INVALIDOPCODE " ++ (show w)++instance Binary ScriptOp where++ get = go =<< (fromIntegral <$> getWord8) + where + go op + | op == 0x00 = return $ OP_0+ | op <= 0x4b = do+ payload <- getByteString (fromIntegral op)+ return $ OP_PUSHDATA payload+ | op == 0x4c = do+ len <- getWord8+ payload <- getByteString (fromIntegral len)+ return $ OP_PUSHDATA payload+ | op == 0x4d = do+ len <- getWord16le+ payload <- getByteString (fromIntegral len)+ return $ OP_PUSHDATA payload+ | op == 0x4e = do+ len <- getWord32le+ payload <- getByteString (fromIntegral len)+ return $ OP_PUSHDATA payload+ | op == 0x4f = return $ OP_1NEGATE+ | op == 0x51 = return $ OP_1+ | op == 0x52 = return $ OP_2+ | op == 0x53 = return $ OP_3+ | op == 0x54 = return $ OP_4+ | op == 0x55 = return $ OP_5+ | op == 0x56 = return $ OP_6+ | op == 0x57 = return $ OP_7+ | op == 0x58 = return $ OP_8+ | op == 0x59 = return $ OP_9+ | op == 0x5a = return $ OP_10+ | op == 0x5b = return $ OP_11+ | op == 0x5c = return $ OP_12+ | op == 0x5d = return $ OP_13+ | op == 0x5e = return $ OP_14+ | op == 0x5f = return $ OP_15+ | op == 0x60 = return $ OP_16+ | op == 0x69 = return $ OP_VERIFY+ | op == 0x76 = return $ OP_DUP+ | op == 0x87 = return $ OP_EQUAL+ | op == 0x88 = return $ OP_EQUALVERIFY+ | op == 0xa9 = return $ OP_HASH160+ | op == 0xac = return $ OP_CHECKSIG+ | op == 0xae = return $ OP_CHECKMULTISIG+ | op == 0xfe = OP_PUBKEY <$> get+ | otherwise = return $ OP_INVALIDOPCODE op++ put op = case op of++ (OP_PUSHDATA payload) -> go payload (BS.length payload)+ where + go p len + | len <= 0 = fail "OP_PUSHDATA: data length must be > 0"+ | len <= 0x4b = do+ putWord8 $ fromIntegral len+ putByteString p+ | len <= 0xff = do+ putWord8 0x4c+ putWord8 $ fromIntegral len+ putByteString p+ | len <= 0xffff = do+ putWord8 0x4d+ putWord16le $ fromIntegral len+ putByteString p+ | len <= 0xffffffff = do+ putWord8 0x4e+ putWord32le $ fromIntegral len+ putByteString p+ | otherwise = + fail "bitcoinPut OP_PUSHDATA payload too big"++ OP_0 -> putWord8 0x00+ OP_1NEGATE -> putWord8 0x4f+ OP_1 -> putWord8 0x51+ OP_2 -> putWord8 0x52+ OP_3 -> putWord8 0x53+ OP_4 -> putWord8 0x54+ OP_5 -> putWord8 0x55+ OP_6 -> putWord8 0x56+ OP_7 -> putWord8 0x57+ OP_8 -> putWord8 0x58+ OP_9 -> putWord8 0x59+ OP_10 -> putWord8 0x5a+ OP_11 -> putWord8 0x5b+ OP_12 -> putWord8 0x5c+ OP_13 -> putWord8 0x5d+ OP_14 -> putWord8 0x5e+ OP_15 -> putWord8 0x5f+ OP_16 -> putWord8 0x60+ OP_VERIFY -> putWord8 0x69+ OP_DUP -> putWord8 0x76+ OP_EQUAL -> putWord8 0x87+ OP_EQUALVERIFY -> putWord8 0x88+ OP_HASH160 -> putWord8 0xa9+ OP_CHECKSIG -> putWord8 0xac+ OP_CHECKMULTISIG -> putWord8 0xae+ (OP_PUBKEY pk) -> putWord8 0xfe >> put pk+ (OP_INVALIDOPCODE _) -> putWord8 0xff+
+ Network/Haskoin/Protocol/Tx.hs view
@@ -0,0 +1,189 @@+module Network.Haskoin.Protocol.Tx +( Tx(..) +, TxIn(..)+, TxOut(..)+, OutPoint(..)+, CoinbaseTx(..)+, txid+, encodeTxid+, decodeTxid+) where++import Control.Monad (replicateM, forM_, liftM2, unless)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32, Word64)+import Data.Binary (Binary, get, put)+import Data.Binary.Get + ( getWord32le+ , getWord64le+ , getByteString+ , skip+ )+import Data.Binary.Put + ( putWord32le+ , putWord64le+ , putByteString+ )+import qualified Data.ByteString as BS + ( ByteString+ , length+ , reverse+ )++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.Script+import Network.Haskoin.Crypto (Hash256, doubleHash256)+import Network.Haskoin.Util (bsToHex, hexToBS, encode', decodeToMaybe)++-- | Data type representing a bitcoin transaction+data Tx = + Tx { + -- | Transaction data format version+ txVersion :: !Word32+ -- | List of transaction inputs+ , txIn :: ![TxIn]+ -- | List of transaction outputs+ , txOut :: ![TxOut]+ -- | The block number of timestamp at which this transaction is locked+ , txLockTime :: !Word32+ } deriving (Eq, Show)++instance Binary Tx where++ get = Tx <$> getWord32le+ <*> (replicateList =<< get)+ <*> (replicateList =<< get)+ <*> getWord32le+ where + replicateList (VarInt c) = replicateM (fromIntegral c) get++ put (Tx 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 type representing the coinbase transaction of a 'Block'. Coinbase+-- transactions are special types of transactions which are created by miners+-- when they find a new block. Coinbase transactions have no inputs. They have+-- outputs sending the newly generated bitcoins together with all the block's+-- fees to a bitcoin address (usually the miners address). Data can be embedded+-- in a Coinbase transaction which can be chosen by the miner of a block. This+-- data also typically contains some randomness which is used, together with+-- the nonce, to find a partial hash collision on the block's hash.+data CoinbaseTx = + CoinbaseTx { + -- | Transaction data format version.+ cbVersion :: !Word32+ -- | Data embedded inside the coinbase transaction.+ , cbData :: !BS.ByteString+ -- | List of transaction outputs.+ , cbOut :: ![TxOut]+ -- | The block number of timestamp at which this + -- transaction is locked.+ , cbLockTime :: !Word32+ } deriving (Eq, Show)++instance Binary CoinbaseTx where++ get = CoinbaseTx <$> getWord32le+ <*> (readCoinbase =<< get)+ <*> (replicateList =<< get)+ <*> getWord32le+ where + readCoinbase (VarInt _) = do+ skip 36 -- skip OutPoint+ (VarInt len) <- get+ coinbase <- getByteString (fromIntegral len)+ skip 4 -- skip sequence+ return coinbase+ replicateList (VarInt c) = replicateM (fromIntegral c) get++ put (CoinbaseTx v cb os l) = do+ putWord32le v+ put $ VarInt 1+ put $ OutPoint 0 maxBound+ put $ VarInt $ fromIntegral $ BS.length cb+ putByteString cb + putWord32le 0 --sequence number+ put $ VarInt $ fromIntegral $ length os+ forM_ os put+ putWord32le l++-- | Data type representing a transaction input.+data TxIn = + TxIn { + -- | Reference the previous transaction output (hash + position)+ prevOutput :: !OutPoint+ -- | Script providing the requirements of the previous transaction+ -- output to spend those coins.+ , scriptInput :: !Script+ -- | Transaction version as defined by the sender of the+ -- transaction. The intended use is for replacing transactions with+ -- new information before the transaction is included in a block.+ , txInSequence :: !Word32+ } deriving (Eq, Show)++instance Binary TxIn where+ get = TxIn <$> get <*> get <*> getWord32le+ put (TxIn o s q) = put o >> put s >> putWord32le q++-- | Data type representing a transaction output.+data TxOut = + TxOut { + -- | Transaction output value.+ outValue :: !Word64+ -- | Script specifying the conditions to spend this output.+ , scriptOutput :: !Script+ } deriving (Eq, Show)++instance Binary TxOut where+ get = do+ val <- getWord64le+ unless (val <= 2100000000000000) $ fail $+ "Invalid TxOut value: " ++ (show val)+ TxOut val <$> get+ put (TxOut o s) = putWord64le o >> put s++-- | The OutPoint is used inside a transaction input to reference the previous+-- transaction output that it is spending.+data OutPoint = + OutPoint { + -- | The hash of the referenced transaction.+ outPointHash :: !Hash256+ -- | The position of the specific output in the transaction.+ -- The first output position is 0.+ , outPointIndex :: !Word32+ } deriving Eq++instance Show OutPoint where+ show (OutPoint h i) = show ("txid = " ++ h',"index = " ++ (show i))+ where + h' = encodeTxid h++instance Binary OutPoint where+ get = do+ (h,i) <- liftM2 (,) get getWord32le+ unless (i <= 2147483647) $ fail $+ "Invalid OutPoint index: " ++ (show i)+ return $ OutPoint h i+ put (OutPoint h i) = put h >> putWord32le i++-- | Computed the hash of a transaction.+txid :: Tx -> Hash256+txid = doubleHash256 . encode' ++-- | Encodes a transaction hash as little endian in HEX format.+-- This is mostly used for displaying transaction ids. Internally, these ids+-- are handled as big endian but are transformed to little endian when+-- displaying them.+encodeTxid :: Hash256 -> String+encodeTxid = bsToHex . BS.reverse . encode' ++-- | Decodes a little endian transaction hash in HEX format. +decodeTxid :: String -> Maybe Hash256+decodeTxid = (decodeToMaybe . BS.reverse =<<) . hexToBS+
+ Network/Haskoin/Protocol/VarInt.hs view
@@ -0,0 +1,46 @@+module Network.Haskoin.Protocol.VarInt ( VarInt(..) ) where+ +import Data.Word (Word64)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)+import Data.Binary.Get + ( getWord8+ , getWord16le+ , getWord32le+ , getWord64le+ )+import Data.Binary.Put + ( putWord8+ , putWord16le+ , putWord32le+ , putWord64le+ )++-- | Data type representing a variable length integer. The 'VarInt' type+-- usually precedes an array or a string that can vary in length. +newtype VarInt = VarInt { getVarInt :: Word64 }+ deriving (Eq, Show)+ +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+
+ Network/Haskoin/Protocol/VarString.hs view
@@ -0,0 +1,29 @@+module Network.Haskoin.Protocol.VarString ( VarString(..) ) where++import Control.Applicative ((<$>))++import qualified Data.ByteString as BS + ( ByteString+ , length+ )+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getByteString)+import Data.Binary.Put (putByteString)++import Network.Haskoin.Protocol.VarInt++-- | Data type for variable length strings. Variable length strings are+-- serialized as a 'VarInt' followed by a bytestring.+newtype VarString = VarString { getVarString :: BS.ByteString }+ deriving (Eq, Show)++instance Binary VarString where++ get = VarString <$> (readBS =<< get)+ where + readBS (VarInt len) = getByteString (fromIntegral len)++ put (VarString bs) = do+ put $ VarInt $ fromIntegral $ BS.length bs+ putByteString bs+
+ Network/Haskoin/Protocol/Version.hs view
@@ -0,0 +1,85 @@+module Network.Haskoin.Protocol.Version ( Version(..) ) where++import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32, Word64)+import Data.Binary (Binary, get, put, Get, Put)+import Data.Binary.Get + ( getWord8+ , getWord32le+ , getWord64le+ , isEmpty+ )+import Data.Binary.Put + ( putWord8+ , putWord32le+ , putWord64le+ )++import Network.Haskoin.Protocol.VarString+import Network.Haskoin.Protocol.NetworkAddress++-- | When a bitcoin node creates an outgoing connection to another node,+-- the first message it will send is a 'Version' message. The other node+-- will similarly respond with it's own 'Version' message.+data Version = + Version {+ -- | Protocol version being used by the node.+ version :: !Word32+ -- | Bitmask of features to enable for this connection.+ , services :: !Word64+ -- | UNIX timestamp+ , timestamp :: !Word64+ -- | Network address of the node receiving this message.+ , addrRecv :: !NetworkAddress+ -- | Network address of the node sending this message.+ , addrSend :: !NetworkAddress+ -- | Randomly generated identifying sent with every version+ -- message. This nonce is used to detect connection to self.+ , verNonce :: !Word64+ -- | User agent+ , userAgent :: !VarString+ -- | The height of the last block received by the sending node.+ , startHeight :: !Word32+ -- | Wether the remote peer should announce relaying transactions+ -- or not. This feature is enabled since version >= 70001. See+ -- BIP37 for more details.+ , relay :: !Bool+ } deriving (Eq, Show)++instance Binary Version where++ get = Version <$> getWord32le+ <*> getWord64le+ <*> getWord64le+ <*> get+ <*> get+ <*> getWord64le+ <*> get+ <*> getWord32le+ <*> (go =<< isEmpty)+ where + go True = return True+ go False = getBool++ put (Version v s t ar as n ua sh r) = do+ putWord32le v+ putWord64le s+ putWord64le t+ put ar+ put as+ putWord64le n+ put ua+ putWord32le sh+ putBool r++getBool :: Get Bool+getBool = go =<< getWord8+ where + go 0 = return False+ go _ = return True++putBool :: Bool -> Put +putBool True = putWord8 1+putBool False = putWord8 0+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ UNLICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org/>
+ haskoin-protocol.cabal view
@@ -0,0 +1,71 @@+name: haskoin-protocol+version: 0.0.1+synopsis: Implementation of the Bitcoin network protocol messages+description: + This package provides all of the basic types used for the Bitcoin + networking protocol together with Data.Binary instances for efficiently+ serializing and de-serializing them.+homepage: http://github.com/plaprade/haskoin-protocol+bug-reports: http://github.com/plaprade/haskoin-protocol/issues+stability: experimental+license: PublicDomain+license-file: UNLICENSE+author: Philippe Laprade+maintainer: plaprade+hackage@gmail.com+category: Bitcoin, Finance, Network+build-type: Simple+cabal-version: >= 1.9.2++source-repository head+ type: git+ location: git://github.com/plaprade/haskoin-protocol.git++library+ exposed-modules: Network.Haskoin.Protocol,+ Network.Haskoin.Protocol.Arbitrary+ other-modules: Network.Haskoin.Protocol.Message,+ Network.Haskoin.Protocol.VarInt,+ Network.Haskoin.Protocol.BlockHeader,+ Network.Haskoin.Protocol.Addr, + Network.Haskoin.Protocol.Tx, + Network.Haskoin.Protocol.NotFound, + Network.Haskoin.Protocol.NetworkAddress, + Network.Haskoin.Protocol.Inv, + Network.Haskoin.Protocol.VarString, + Network.Haskoin.Protocol.GetBlocks, + Network.Haskoin.Protocol.Ping, + Network.Haskoin.Protocol.Script, + Network.Haskoin.Protocol.InvVector, + Network.Haskoin.Protocol.Alert, + Network.Haskoin.Protocol.MessageHeader, + Network.Haskoin.Protocol.Block, + Network.Haskoin.Protocol.Version, + Network.Haskoin.Protocol.GetData, + Network.Haskoin.Protocol.Headers, + Network.Haskoin.Protocol.GetHeaders+ build-depends: base == 4.6.*, + binary == 0.7.*, + bytestring == 0.10.*, + haskoin-util == 0.0.*,+ haskoin-crypto == 0.0.*,+ QuickCheck == 2.6.*+ ghc-options: -Wall -fno-warn-orphans++Test-Suite test-haskoin-protocol+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules: Network.Haskoin.Protocol.Tests,+ Units+ build-depends: base == 4.6.*,+ binary == 0.7.*, + bytestring == 0.10.*, + haskoin-util == 0.0.*,+ haskoin-crypto == 0.0.*,+ QuickCheck == 2.6.*,+ test-framework == 0.8.*,+ test-framework-quickcheck2 == 0.3.*,+ test-framework-hunit == 0.3.*,+ HUnit == 1.2.*+ hs-source-dirs: . tests+ ghc-options: -Wall -fno-warn-orphans+
+ tests/Main.hs view
@@ -0,0 +1,13 @@+module Main where++import Test.Framework (defaultMain)++import qualified Network.Haskoin.Protocol.Tests (tests)+import qualified Units (tests)++main :: IO ()+main = defaultMain + ( Network.Haskoin.Protocol.Tests.tests+ ++ Units.tests+ )+
+ tests/Network/Haskoin/Protocol/Tests.hs view
@@ -0,0 +1,56 @@+module Network.Haskoin.Protocol.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Maybe+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put++import Network.Haskoin.Protocol.Arbitrary()+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto++tests :: [Test]+tests = + [ testGroup "Serialize & de-serialize protocol messages"+ [ testProperty "VarInt" (metaGetPut :: VarInt -> Bool)+ , testProperty "VarString" (metaGetPut :: VarString -> Bool)+ , testProperty "NetworkAddress" (metaGetPut :: NetworkAddress -> Bool)+ , testProperty "InvType" (metaGetPut :: InvType -> Bool)+ , testProperty "InvVector" (metaGetPut :: InvVector -> Bool)+ , testProperty "Inv" (metaGetPut :: Inv -> Bool)+ , testProperty "Version" (metaGetPut :: Version -> Bool)+ , testProperty "Addr" (metaGetPut :: Addr -> Bool)+ , testProperty "Alert" (metaGetPut :: Alert -> Bool)+ , testProperty "TxIn" (metaGetPut :: TxIn -> Bool)+ , testProperty "TxOut" (metaGetPut :: TxOut -> Bool)+ , testProperty "OutPoint" (metaGetPut :: OutPoint -> Bool)+ , testProperty "ScriptOp" (metaGetPut :: ScriptOp -> Bool)+ , testProperty "Script" (metaGetPut :: Script -> Bool)+ , testProperty "Tx" (metaGetPut :: Tx -> Bool)+ , testProperty "CoinbaseTx" (metaGetPut :: CoinbaseTx -> Bool)+ , testProperty "BlockHeader" (metaGetPut :: BlockHeader -> Bool)+ , testProperty "Block" (metaGetPut :: Block -> Bool)+ , testProperty "GetBlocks" (metaGetPut :: GetBlocks -> Bool)+ , testProperty "GetData" (metaGetPut :: GetData -> Bool)+ , testProperty "GetHeaders" (metaGetPut :: GetHeaders -> Bool)+ , testProperty "Headers" (metaGetPut :: Headers -> Bool)+ , testProperty "NotFound" (metaGetPut :: NotFound -> Bool)+ , testProperty "Ping" (metaGetPut :: Ping -> Bool)+ , testProperty "Pong" (metaGetPut :: Pong -> Bool)+ , testProperty "MessageCommand" (metaGetPut :: MessageCommand -> Bool)+ , testProperty "MessageHeader" (metaGetPut :: MessageHeader -> Bool)+ , testProperty "Message" (metaGetPut :: Message -> Bool)+ ]+ , testGroup "Transactions"+ [ testProperty "decode . encode Txid" decEncTxid ]+ ]++metaGetPut :: (Binary a, Eq a) => a -> Bool+metaGetPut x = (runGet get (runPut $ put x)) == x++decEncTxid :: Hash256 -> Bool+decEncTxid h = (fromJust $ decodeTxid $ encodeTxid h) == h+
+ tests/Units.hs view
@@ -0,0 +1,44 @@+module Units (tests) where++import Test.HUnit (Assertion, assertBool)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Maybe++import Network.Haskoin.Protocol+import Network.Haskoin.Util++tests :: [Test]+tests =+ [ testGroup "Computing TxID from Tx" + ( map mapTxIDVec $ zip txIDVec [0..] )+ ]++mapTxIDVec :: ((String,String),Int) -> Test.Framework.Test+mapTxIDVec (v,i) = testCase name $ runTxIDVec v+ where + name = "Compute TxID " ++ (show i)++runTxIDVec :: (String,String) -> Assertion+runTxIDVec (tid,tx) = assertBool "TxID" $ + (encodeTxid $ txid txBS) == tid+ where + txBS = decode' $ fromJust $ hexToBS tx++txIDVec :: [(String,String)]+txIDVec =+ [ ( "23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63"+ , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa43ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f00000000001976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"+ )+ , ( "c99c49da4c38af669dea436d3e73780dfdb6c1ecf9958baa52960e8baee30e73"+ , "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d00000000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac00000000"+ )+ , ( "f7fdd091fa6d8f5e7a8c2458f5c38faffff2d3f1406b6e4fe2c99dcc0d2d1cbb"+ , "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332adfca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a4730440220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f81e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df32949d4646dfa10a92458cfaa88ac00000000"+ )+ , ( "afd9c17f8913577ec3509520bd6e5d63e9c0fd2a5f70c787993b097ba6ca9fae"+ , "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c59da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbea097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf950650802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e18217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a3788dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9cfdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa34b26f62db4a88ac00000000"+ )+ ]+