diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,13 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## 0.10.0 +### Added +- DeepSeq instances for all data types. + +### Changed +- There is no `SockAddr` inside `NetworkAddress` anymore. + ## 0.9.8 ### Added - Ord instance for `DerivPathI` diff --git a/haskoin-core.cabal b/haskoin-core.cabal --- a/haskoin-core.cabal +++ b/haskoin-core.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 4574f1ec2da07e0ffe26200ecf9819686ab0e99a15cde4a513b8b45e4b62c06d +-- hash: cfbef0e7719a233ca75f665e0d599785821a017710e76f6d1e3af08e07c2424f name: haskoin-core -version: 0.9.8 +version: 0.10.0 synopsis: Bitcoin & Bitcoin Cash library for Haskell description: Haskoin Core is a complete Bitcoin and Bitcoin Cash library of functions and data types for Haskell developers. category: Bitcoin, Finance, Network @@ -16,7 +16,7 @@ author: Philippe Laprade, Jean-Pierre Rupp, Matthew Wraith -maintainer: xenog@protonmail.com +maintainer: jprupp@protonmail.ch license: PublicDomain license-file: UNLICENSE build-type: Simple @@ -92,6 +92,7 @@ , conduit , containers , cryptonite + , deepseq , entropy , hashable , hspec @@ -141,6 +142,7 @@ , bytestring , cereal , containers + , deepseq , haskoin-core , hspec , mtl diff --git a/src/Network/Haskoin/Address.hs b/src/Network/Haskoin/Address.hs --- a/src/Network/Haskoin/Address.hs +++ b/src/Network/Haskoin/Address.hs @@ -45,6 +45,7 @@ ) where import Control.Applicative +import Control.DeepSeq import Control.Monad import Data.Aeson as A import Data.Aeson.Types @@ -82,7 +83,7 @@ | WitnessScriptAddress { getAddrHash256 :: !Hash256 -- ^ HASH256 hash of script } - deriving (Eq, Ord, Generic, Show, Read, Serialize, Hashable) + deriving (Eq, Ord, Generic, Show, Read, Serialize, Hashable, NFData) -- | 'Address' pays to a public key hash. isPubKeyAddress :: Address -> Bool diff --git a/src/Network/Haskoin/Block/Common.hs b/src/Network/Haskoin/Block/Common.hs --- a/src/Network/Haskoin/Block/Common.hs +++ b/src/Network/Haskoin/Block/Common.hs @@ -28,6 +28,7 @@ , encodeCompact ) where +import Control.DeepSeq import Control.Monad (forM_, liftM2, mzero, replicateM) import Data.Aeson (FromJSON, ToJSON, @@ -46,7 +47,7 @@ import Data.String.Conversions (cs) import Data.Text (Text) import Data.Word (Word32) -import GHC.Generics +import GHC.Generics (Generic) import Network.Haskoin.Crypto.Hash import Network.Haskoin.Network.Common import Network.Haskoin.Transaction.Common @@ -63,7 +64,7 @@ data Block = Block { blockHeader :: !BlockHeader , blockTxns :: ![Tx] - } deriving (Eq, Show, Read, Generic, Hashable) + } deriving (Eq, Show, Read, Generic, Hashable, NFData) instance Serialize Block where get = do @@ -84,10 +85,10 @@ withText "Block" $ \t -> do bin <- case decodeHex t of - Nothing -> mzero + Nothing -> mzero Just bin -> return bin case decode bin of - Left e -> fail e + Left e -> fail e Right h -> return h instance ToJSON BlockHeader where @@ -98,16 +99,16 @@ withText "BlockHeader" $ \t -> do bin <- case decodeHex t of - Nothing -> mzero + Nothing -> mzero Just bin -> return bin case decode bin of - Left e -> fail e + Left e -> fail e Right h -> return h -- | Block header hash. To be serialized reversed for display purposes. newtype BlockHash = BlockHash { getBlockHash :: Hash256 } - deriving (Eq, Ord, Generic, Hashable, Serialize) + deriving (Eq, Ord, Generic, Hashable, Serialize, NFData) instance Show BlockHash where showsPrec _ = shows . blockHashToHex @@ -160,7 +161,7 @@ , blockBits :: !Word32 -- 4 bytes -- | random nonce , bhNonce :: !Word32 -- 4 bytes - } deriving (Eq, Ord, Show, Read, Generic, Hashable) + } deriving (Eq, Ord, Show, Read, Generic, Hashable, NFData) -- 80 bytes -- | Compute hash of 'BlockHeader'. @@ -213,7 +214,7 @@ , getBlocksLocator :: !BlockLocator -- | hash of the last desired block , getBlocksHashStop :: !BlockHash - } deriving (Eq, Show) + } deriving (Eq, Show, Generic, NFData) instance Serialize GetBlocks where @@ -245,7 +246,7 @@ , getHeadersBL :: !BlockLocator -- | hash of the last desired block header , getHeadersHashStop :: !BlockHash - } deriving (Eq, Show) + } deriving (Eq, Show, Generic, NFData) instance Serialize GetHeaders where @@ -266,7 +267,7 @@ Headers { -- | list of block headers with transaction count headersList :: [BlockHeaderCount] } - deriving (Eq, Show) + deriving (Eq, Show, Generic, NFData) instance Serialize Headers where diff --git a/src/Network/Haskoin/Block/Headers.hs b/src/Network/Haskoin/Block/Headers.hs --- a/src/Network/Haskoin/Block/Headers.hs +++ b/src/Network/Haskoin/Block/Headers.hs @@ -62,6 +62,7 @@ , ) where import Control.Applicative ((<|>)) +import Control.DeepSeq import Control.Monad (guard, unless, when) import Control.Monad.Except (ExceptT (..), runExceptT, throwError) @@ -85,7 +86,7 @@ import Data.Serialize.Put as S import Data.Typeable (Typeable) import Data.Word (Word32, Word64) -import GHC.Generics +import GHC.Generics (Generic) import Network.Haskoin.Block.Common import Network.Haskoin.Constants import Network.Haskoin.Crypto @@ -118,7 +119,7 @@ | GenesisNode { nodeHeader :: !BlockHeader , nodeHeight :: !BlockHeight , nodeWork :: !BlockWork } - deriving (Show, Read, Generic, Hashable) + deriving (Show, Read, Generic, Hashable, NFData) instance Serialize BlockNode where get = do @@ -148,7 +149,7 @@ data HeaderMemory = HeaderMemory { memoryHeaderMap :: !BlockMap , memoryBestHeader :: !BlockNode - } deriving (Eq, Typeable, Show, Read, Generic, Hashable) + } deriving (Eq, Typeable, Show, Read, Generic, Hashable, NFData) -- | Typeclass for block header chain storage monad. class Monad m => BlockHeaders m where diff --git a/src/Network/Haskoin/Block/Merkle.hs b/src/Network/Haskoin/Block/Merkle.hs --- a/src/Network/Haskoin/Block/Merkle.hs +++ b/src/Network/Haskoin/Block/Merkle.hs @@ -33,6 +33,7 @@ , boolsToWord8 ) where +import Control.DeepSeq import Control.Monad (forM_, replicateM, when) import Data.Bits import qualified Data.ByteString as BS @@ -72,7 +73,7 @@ , mHashes :: !PartialMerkleTree -- | bits to rebuild partial merkle tree , mFlags :: !FlagBits - } deriving (Eq, Show, Read, Generic, Hashable) + } deriving (Eq, Show, Read, Generic, Hashable, NFData) instance Serialize MerkleBlock where diff --git a/src/Network/Haskoin/Constants.hs b/src/Network/Haskoin/Constants.hs --- a/src/Network/Haskoin/Constants.hs +++ b/src/Network/Haskoin/Constants.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-| @@ -24,6 +25,7 @@ , netByIdent ) where +import Control.DeepSeq import Data.ByteString (ByteString) import Data.List import Data.Maybe @@ -107,7 +109,7 @@ , getReplaceByFee :: !Bool -- | Subsidy halving interval , getHalvingInterval :: !Word32 - } deriving (Eq, Generic) + } deriving (Eq, Generic, NFData) instance Serialize Network where put net = diff --git a/src/Network/Haskoin/Crypto/Hash.hs b/src/Network/Haskoin/Crypto/Hash.hs --- a/src/Network/Haskoin/Crypto/Hash.hs +++ b/src/Network/Haskoin/Crypto/Hash.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} {-| Module : Network.Haskoin.Crypto.Hash Copyright : No rights reserved @@ -29,6 +30,7 @@ , join512 ) where +import Control.DeepSeq import Crypto.Hash (RIPEMD160 (..), SHA1 (..), SHA256 (..), SHA512 (..), hashWith) import Crypto.MAC.HMAC (HMAC, hmac) @@ -46,25 +48,26 @@ import Data.String (IsString, fromString) import Data.String.Conversions (cs) import Data.Word (Word32) +import GHC.Generics (Generic) import Network.Haskoin.Util import Text.Read as R -- | 'Word32' wrapped for type-safe 32-bit checksums. newtype CheckSum32 = CheckSum32 { getCheckSum32 :: Word32 - } deriving (Eq, Ord, Serialize, Show, Read, Hashable) + } deriving (Eq, Ord, Serialize, Show, Read, Hashable, Generic, NFData) -- | Type for 512-bit hashes. newtype Hash512 = Hash512 { getHash512 :: ShortByteString } - deriving (Eq, Ord, Hashable) + deriving (Eq, Ord, Hashable, Generic, NFData) -- | Type for 256-bit hashes. newtype Hash256 = Hash256 { getHash256 :: ShortByteString } - deriving (Eq, Ord, Hashable) + deriving (Eq, Ord, Hashable, Generic, NFData) -- | Type for 160-bit hashes. newtype Hash160 = Hash160 { getHash160 :: ShortByteString } - deriving (Eq, Ord, Hashable) + deriving (Eq, Ord, Hashable, Generic, NFData) instance Show Hash512 where showsPrec _ = shows . encodeHex . BSS.fromShort . getHash512 diff --git a/src/Network/Haskoin/Keys/Common.hs b/src/Network/Haskoin/Keys/Common.hs --- a/src/Network/Haskoin/Keys/Common.hs +++ b/src/Network/Haskoin/Keys/Common.hs @@ -32,6 +32,7 @@ ) where import Control.Applicative ((<|>)) +import Control.DeepSeq import Control.Monad (guard, mzero, (<=<)) import Crypto.Secp256k1 import Data.Aeson (FromJSON, ToJSON, Value (String), @@ -54,7 +55,7 @@ data PubKeyI = PubKeyI { pubKeyPoint :: !PubKey , pubKeyCompressed :: !Bool - } deriving (Generic, Eq, Show, Read, Hashable) + } deriving (Generic, Eq, Show, Read, Hashable, NFData) instance IsString PubKeyI where fromString str = @@ -103,7 +104,7 @@ data SecKeyI = SecKeyI { secKeyData :: !SecKey , secKeyCompressed :: !Bool - } deriving (Eq, Show, Read) + } deriving (Eq, Show, Read, Generic, NFData) -- | Wrap private key with corresponding public key compression flag. wrapSecKey :: Bool -> SecKey -> SecKeyI diff --git a/src/Network/Haskoin/Keys/Extended.hs b/src/Network/Haskoin/Keys/Extended.hs --- a/src/Network/Haskoin/Keys/Extended.hs +++ b/src/Network/Haskoin/Keys/Extended.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -99,6 +100,7 @@ ) where import Control.Applicative +import Control.DeepSeq import Control.Exception (Exception, throw) import Control.Monad (guard, mzero, unless, (<=<)) import Crypto.Secp256k1 @@ -139,7 +141,7 @@ -- | A derivation exception is thrown in the very unlikely event that a -- derivation is invalid. newtype DerivationException = DerivationException String - deriving (Eq, Read, Show, Typeable) + deriving (Eq, Read, Show, Typeable, Generic, NFData) instance Exception DerivationException @@ -161,7 +163,7 @@ , xPrvIndex :: !KeyIndex -- ^ derivation index , xPrvChain :: !ChainCode -- ^ chain code , xPrvKey :: !SecKey -- ^ private key of this node - } deriving (Generic, Eq, Show, Read) + } deriving (Generic, Eq, Show, Read, NFData) xPrvToJSON :: Network -> XPrvKey -> Value xPrvToJSON net = A.String . xPrvExport net @@ -173,7 +175,7 @@ , xPubIndex :: !KeyIndex -- ^ derivation index , xPubChain :: !ChainCode -- ^ chain code , xPubKey :: !PubKey -- ^ public key of this node - } deriving (Generic, Eq, Show, Read) + } deriving (Generic, Eq, Show, Read, NFData) -- | Decode an extended public key from a JSON string @@ -486,14 +488,14 @@ -- | Phantom type signaling a hardened derivation path that can only be computed -- from private extended key. -data HardDeriv +data HardDeriv deriving (Generic, NFData) -- | Phantom type signaling no knowledge about derivation path: can be hardened or not. -data AnyDeriv +data AnyDeriv deriving (Generic, NFData) -- | Phantom type signaling derivation path including only non-hardened paths -- that can be computed from an extended public key. -data SoftDeriv +data SoftDeriv deriving (Generic, NFData) -- | Hardened derivation path. Can be computed from extended private key only. type HardPath = DerivPathI HardDeriv @@ -533,6 +535,11 @@ (:/) :: AnyOrSoft t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t Deriv :: DerivPathI t +instance NFData (DerivPathI t) where + rnf (a :| b) = rnf a `seq` rnf b `seq` () + rnf (a :/ b) = rnf a `seq` rnf b `seq` () + rnf Deriv = () + instance Eq (DerivPathI t) where (nextA :| iA) == (nextB :| iB) = iA == iB && nextA == nextB (nextA :/ iA) == (nextB :/ iB) = iA == iB && nextA == nextB @@ -730,7 +737,7 @@ data ParsedPath = ParsedPrv { getParsedPath :: !DerivPath } | ParsedPub { getParsedPath :: !DerivPath } | ParsedEmpty { getParsedPath :: !DerivPath } - deriving Eq + deriving (Eq, Generic, NFData) instance Show ParsedPath where showsPrec d p = showParen (d > 10) $ showString "ParsedPath " . shows f @@ -779,7 +786,7 @@ -- | Type for BIP32 path index element. data Bip32PathIndex = Bip32HardIndex KeyIndex | Bip32SoftIndex KeyIndex - deriving Eq + deriving (Eq, Generic, NFData) instance Show Bip32PathIndex where showsPrec d (Bip32HardIndex i) = showParen (d > 10) $ @@ -821,7 +828,7 @@ , getXKeyNet :: !Network } | XPub { getXKeyPub :: !XPubKey , getXKeyNet :: !Network } - deriving (Eq, Show) + deriving (Eq, Show, Generic, NFData) -- | Apply a parsed path to an extended key to derive the new key defined in the -- path. If the path starts with /m/, a private key will be returned and if the diff --git a/src/Network/Haskoin/Network/Bloom.hs b/src/Network/Haskoin/Network/Bloom.hs --- a/src/Network/Haskoin/Network/Bloom.hs +++ b/src/Network/Haskoin/Network/Bloom.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-| Module : Network.Haskoin.Network.Bloom Copyright : No rights reserved @@ -27,23 +29,26 @@ , bloomRelevantUpdate ) where -import Control.Monad (forM_, replicateM) +import Control.DeepSeq +import Control.Monad (forM_, replicateM) import Data.Bits -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import qualified Data.Foldable as F -import Data.Hash.Murmur (murmur3) -import qualified Data.Sequence as S -import Data.Serialize (Serialize, get, put,encode) -import Data.Serialize.Get (getByteString, getWord32le, - getWord8) -import Data.Serialize.Put (putByteString, putWord32le, - putWord8) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.Foldable as F +import Data.Hash.Murmur (murmur3) +import Data.List (foldl') +import qualified Data.Sequence as S +import Data.Serialize (Serialize, encode, get, + put) +import Data.Serialize.Get (getByteString, getWord32le, + getWord8) +import Data.Serialize.Put (putByteString, putWord32le, + putWord8) import Data.Word +import GHC.Generics (Generic) import Network.Haskoin.Network.Common import Network.Haskoin.Script.Common import Network.Haskoin.Transaction.Common -import Data.List (foldl') -- | 20,000 items with fp rate < 0.1% or 10,000 items and <0.0001% maxBloomSize :: Int maxBloomSize = 36000 @@ -67,7 +72,7 @@ | BloomUpdateAll -- ^ auto-update on all outputs | BloomUpdateP2PubKeyOnly -- ^ auto-update on pay-to-pubkey or pay-to-multisig (default) - deriving (Eq, Show, Read) + deriving (Eq, Show, Read, Generic, NFData) instance Serialize BloomFlags where get = go =<< getWord8 @@ -98,7 +103,7 @@ , bloomFlags :: !BloomFlags -- ^ bloom filter auto-update flags } - deriving (Eq, Show, Read) + deriving (Eq, Show, Read, Generic, NFData) instance Serialize BloomFilter where @@ -117,7 +122,7 @@ -- | Set a new bloom filter on the peer connection. newtype FilterLoad = FilterLoad { filterLoadBloomFilter :: BloomFilter } - deriving (Eq, Show, Read) + deriving (Eq, Show, Read, Generic, NFData) instance Serialize FilterLoad where get = FilterLoad <$> get @@ -126,7 +131,7 @@ -- | Add the given data element to the connections current filter without -- requiring a completely new one to be set. newtype FilterAdd = FilterAdd { getFilterData :: ByteString } - deriving (Eq, Show, Read) + deriving (Eq, Show, Read, Generic, NFData) instance Serialize FilterAdd where get = do @@ -197,13 +202,13 @@ .&. (bitMask !! fromIntegral (7 .&. i)) /= 0 -- | Checks if any of the outputs of a tx is in the current bloom filter. --- If it is, add the txid and vout as an outpoint (i.e. so that +-- If it is, add the txid and vout as an outpoint (i.e. so that -- a future tx that spends the output won't be missed). -bloomRelevantUpdate :: BloomFilter +bloomRelevantUpdate :: BloomFilter -- ^ Bloom filter - -> Tx + -> Tx -- ^ Tx that may (or may not) have relevant outputs - -> Maybe BloomFilter + -> Maybe BloomFilter -- ^ Returns an updated bloom filter adding relevant output bloomRelevantUpdate bfilter tx | isBloomFull bfilter || isBloomEmpty bfilter = Nothing diff --git a/src/Network/Haskoin/Network/Common.hs b/src/Network/Haskoin/Network/Common.hs --- a/src/Network/Haskoin/Network/Common.hs +++ b/src/Network/Haskoin/Network/Common.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Network.Haskoin.Network.Common @@ -18,6 +21,9 @@ , Inv(..) , InvVector(..) , InvType(..) + , HostAddress + , hostToSockAddr + , sockToHostAddress , NetworkAddress(..) , NotFound(..) , Ping(..) @@ -41,17 +47,17 @@ , putVarInt ) where +import Control.DeepSeq import Control.Monad (forM_, liftM2, replicateM, unless) import Data.Bits (shiftL) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.ByteString.Char8 as C (replicate) -import Data.Maybe -import Data.Monoid ((<>)) import Data.Serialize as S import Data.String import Data.String.Conversions (cs) import Data.Word (Word32, Word64) +import GHC.Generics (Generic) import Network.Haskoin.Crypto.Hash import Network.Socket (SockAddr (..)) import Text.Read as R @@ -65,7 +71,7 @@ Addr { -- List of addresses of other nodes on the network with timestamps. addrList :: [NetworkAddressTime] } - deriving (Eq, Show) + deriving (Eq, Show, Generic, NFData) instance Serialize Addr where @@ -87,7 +93,7 @@ alertPayload :: !VarString -- | ECDSA signature of the payload , alertSignature :: !VarString - } deriving (Eq, Show, Read) + } deriving (Eq, Show, Read, Generic, NFData) instance Serialize Alert where get = Alert <$> S.get <*> S.get @@ -103,7 +109,7 @@ newtype GetData = GetData { -- | list of object hashes getDataList :: [InvVector] - } deriving (Eq, Show) + } deriving (Eq, Show, Generic, NFData) instance Serialize GetData where @@ -122,7 +128,7 @@ Inv { -- | inventory invList :: [InvVector] - } deriving (Eq, Show) + } deriving (Eq, Show, Generic, NFData) instance Serialize Inv where @@ -144,7 +150,7 @@ | InvWitnessTx -- ^ segwit transaction | InvWitnessBlock -- ^ segwit block | InvWitnessMerkleBlock -- ^ segwit filtere block - deriving (Eq, Show, Read) + deriving (Eq, Show, Read, Generic, NFData) instance Serialize InvType where get = go =<< getWord32le @@ -180,12 +186,20 @@ invType :: !InvType -- | 256-bit hash of object , invHash :: !Hash256 - } deriving (Eq, Show) + } deriving (Eq, Show, Generic, NFData) instance Serialize InvVector where get = InvVector <$> S.get <*> S.get put (InvVector t h) = put t >> put h +newtype HostAddress = + HostAddress ByteString + deriving (Eq, Show, Ord, Generic, NFData) + +instance Serialize HostAddress where + put (HostAddress bs) = putByteString bs + get = HostAddress <$> getByteString 18 + -- | Data type describing a bitcoin network address. Addresses are stored in -- IPv6 format. IPv4 addresses are mapped to IPv6 using IPv4 mapped IPv6 -- addresses: . @@ -193,46 +207,54 @@ NetworkAddress { -- | bitmask of services available for this address naServices :: !Word64 -- | address and port information - , naAddress :: !SockAddr - } deriving (Eq, Show) + , naAddress :: !HostAddress + } deriving (Eq, Show, Generic, NFData) -instance Serialize NetworkAddress where +hostToSockAddr :: HostAddress -> SockAddr +hostToSockAddr (HostAddress bs) = + case runGet getSockAddr bs of + Left e -> error e + Right x -> x - get = NetworkAddress <$> getWord64le - <*> getAddrPort - where - getAddrPort = do - a <- getWord32be - b <- getWord32be - c <- getWord32be - if a == 0x00000000 && b == 0x00000000 && c == 0x0000ffff - then do - d <- getWord32host - p <- getWord16be - return $ SockAddrInet (fromIntegral p) d - else do - d <- getWord32be - p <- getWord16be - return $ SockAddrInet6 (fromIntegral p) 0 (a,b,c,d) 0 +sockToHostAddress :: SockAddr -> HostAddress +sockToHostAddress = HostAddress . runPut . putSockAddr - put (NetworkAddress s (SockAddrInet6 p _ (a,b,c,d) _)) = do - putWord64le s - putWord32be a - putWord32be b - putWord32be c - putWord32be d - putWord16be (fromIntegral p) +putSockAddr :: SockAddr -> Put +putSockAddr (SockAddrInet6 p _ (a, b, c, d) _) = do + putWord32be a + putWord32be b + putWord32be c + putWord32be d + putWord16be (fromIntegral p) - put (NetworkAddress s (SockAddrInet p a)) = do - putWord64le s - putWord32be 0x00000000 - putWord32be 0x00000000 - putWord32be 0x0000ffff - putWord32host a - putWord16be (fromIntegral p) +putSockAddr (SockAddrInet p a) = do + putWord32be 0x00000000 + putWord32be 0x00000000 + putWord32be 0x0000ffff + putWord32host a + putWord16be (fromIntegral p) - put _ = error "NetworkAddress can onle be IPv4 or IPv6" +putSockAddr _ = error "Invalid address type" +getSockAddr :: Get SockAddr +getSockAddr = do + a <- getWord32be + b <- getWord32be + c <- getWord32be + if a == 0x00000000 && b == 0x00000000 && c == 0x0000ffff + then do + d <- getWord32host + p <- getWord16be + return $ SockAddrInet (fromIntegral p) d + else do + d <- getWord32be + p <- getWord16be + return $ SockAddrInet6 (fromIntegral p) 0 (a, b, c, d) 0 + +instance Serialize NetworkAddress where + get = NetworkAddress <$> getWord64le <*> S.get + put (NetworkAddress s a) = putWord64le s >> put a + -- | 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 @@ -240,7 +262,7 @@ newtype NotFound = NotFound { -- | Inventory vectors related to this request notFoundList :: [InvVector] - } deriving (Eq, Show) + } deriving (Eq, Show, Generic, NFData) instance Serialize NotFound where @@ -258,14 +280,14 @@ Ping { -- | A random nonce used to identify the recipient of the ping -- request once a Pong response is received. pingNonce :: Word64 - } deriving (Eq, Show, Read) + } deriving (Eq, Show, Read, Generic, NFData) -- | A Pong message is sent as a response to a ping message. newtype Pong = Pong { -- | nonce from corresponding 'Ping' pongNonce :: Word64 - } deriving (Eq, Show, Read) + } deriving (Eq, Show, Read, Generic, NFData) instance Serialize Ping where get = Ping <$> getWord64le @@ -286,7 +308,7 @@ , rejectReason :: !VarString -- | extra data such as block or tx hash , rejectData :: !ByteString - } deriving (Eq, Show, Read) + } deriving (Eq, Show, Read, Generic, NFData) -- | Rejection code associated to the 'Reject' message. data RejectCode @@ -298,7 +320,7 @@ | RejectDust | RejectInsufficientFee | RejectCheckpoint - deriving (Eq, Show, Read) + deriving (Eq, Show, Read, Generic, NFData) instance Serialize RejectCode where @@ -350,7 +372,7 @@ -- | 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, Read) + deriving (Eq, Show, Read, Generic, NFData) instance Serialize VarInt where @@ -379,7 +401,7 @@ -- | Data type for serialization of variable-length strings. newtype VarString = VarString { getVarString :: ByteString } - deriving (Eq, Show, Read) + deriving (Eq, Show, Read, Generic, NFData) instance Serialize VarString where @@ -414,7 +436,7 @@ , startHeight :: !Word32 -- | relay transactions flag (BIP-37) , relay :: !Bool - } deriving (Eq, Show) + } deriving (Eq, Show, Generic, NFData) instance Serialize Version where @@ -482,7 +504,7 @@ | MCReject | MCSendHeaders | MCOther ByteString - deriving (Eq) + deriving (Eq, Generic, NFData) instance Show MessageCommand where showsPrec _ = shows . commandToString @@ -555,7 +577,7 @@ MCMempool -> "mempool" MCReject -> "reject" MCSendHeaders -> "sendheaders" - MCOther c -> c + MCOther c -> c -- | Pack a string 'MessageCommand' so that it is exactly 12-bytes long. packCommand :: ByteString -> ByteString diff --git a/src/Network/Haskoin/Network/Message.hs b/src/Network/Haskoin/Network/Message.hs --- a/src/Network/Haskoin/Network/Message.hs +++ b/src/Network/Haskoin/Network/Message.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-| Module : Network.Haskoin.Network.Message Copyright : No rights reserved @@ -18,6 +20,7 @@ ) where import Control.Monad (unless) +import Control.DeepSeq import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Serialize (Serialize, encode, get, @@ -28,6 +31,7 @@ import Data.Serialize.Put (Putter, putByteString, putWord32be, putWord32le) import Data.Word (Word32) +import GHC.Generics (Generic) import Network.Haskoin.Block.Common import Network.Haskoin.Block.Merkle import Network.Haskoin.Constants @@ -47,7 +51,7 @@ , headPayloadSize :: !Word32 -- | checksum of payload , headChecksum :: !CheckSum32 - } deriving (Eq, Show) + } deriving (Eq, Show, Generic, NFData) instance Serialize MessageHeader where @@ -92,7 +96,7 @@ | MReject !Reject | MSendHeaders | MOther !ByteString !ByteString - deriving (Eq, Show) + deriving (Eq, Show, Generic, NFData) -- | Get 'MessageCommand' assocated with a message. msgType :: Message -> MessageCommand @@ -153,13 +157,16 @@ MCAlert -> MAlert <$> get MCReject -> MReject <$> get MCOther c -> MOther c <$> getByteString (fromIntegral len) + _ -> fail $ "get: command " ++ show cmd ++ + " should not carry a payload" else case cmd of MCGetAddr -> return MGetAddr MCVerAck -> return MVerAck MCFilterClear -> return MFilterClear MCMempool -> return MMempool MCSendHeaders -> return MSendHeaders - _ -> fail $ "get: Invalid command " ++ show cmd + _ -> fail $ "get: command " ++ show cmd ++ + " is expected to carry a payload" -- | Serializer for network messages. putMessage :: Network -> Putter Message diff --git a/src/Network/Haskoin/Script/Common.hs b/src/Network/Haskoin/Script/Common.hs --- a/src/Network/Haskoin/Script/Common.hs +++ b/src/Network/Haskoin/Script/Common.hs @@ -35,6 +35,7 @@ , scriptOpToInt ) where +import Control.DeepSeq import Control.Monad import Data.Aeson as A import Data.ByteString (ByteString) @@ -65,7 +66,7 @@ -- | script operators defining this script scriptOps :: [ScriptOp] } - deriving (Eq, Show, Read, Generic, Hashable) + deriving (Eq, Show, Read, Generic, Hashable, NFData) instance Serialize Script where get = @@ -90,7 +91,7 @@ | OPDATA2 -- | next four bytes contains the number of bytes to be pushed | OPDATA4 - deriving (Show, Read, Eq, Generic, Hashable) + deriving (Show, Read, Eq, Generic, Hashable, NFData) -- | Data type representing an operator allowed inside a 'Script'. data ScriptOp @@ -219,7 +220,7 @@ | OP_PUBKEYHASH | OP_PUBKEY | OP_INVALIDOPCODE !Word8 - deriving (Show, Read, Eq, Generic, Hashable) + deriving (Show, Read, Eq, Generic, Hashable, NFData) instance Serialize ScriptOp where get = go =<< (fromIntegral <$> getWord8) @@ -380,22 +381,22 @@ let len = B.length payload case optype of OPCODE -> do - unless (len <= 0x4b) $ fail - "OP_PUSHDATA OPCODE: Payload size too big" + unless (len <= 0x4b) $ + error "OP_PUSHDATA OPCODE: Payload size too big" putWord8 $ fromIntegral len OPDATA1 -> do - unless (len <= 0xff) $ fail - "OP_PUSHDATA OPDATA1: Payload size too big" + unless (len <= 0xff) $ + error "OP_PUSHDATA OPDATA1: Payload size too big" putWord8 0x4c putWord8 $ fromIntegral len OPDATA2 -> do - unless (len <= 0xffff) $ fail - "OP_PUSHDATA OPDATA2: Payload size too big" + unless (len <= 0xffff) $ + error "OP_PUSHDATA OPDATA2: Payload size too big" putWord8 0x4d putWord16le $ fromIntegral len OPDATA4 -> do - unless (len <= 0x7fffffff) $ fail - "OP_PUSHDATA OPDATA4: Payload size too big" + unless (len <= 0x7fffffff) $ + error "OP_PUSHDATA OPDATA4: Payload size too big" putWord8 0x4e putWord32le $ fromIntegral len putByteString payload @@ -608,7 +609,7 @@ | PayWitnessScriptHash { getScriptHash :: !Hash256 } -- | provably unspendable data carrier | DataCarrier { getOutputData :: !ByteString } - deriving (Eq, Show, Read, Generic, Hashable) + deriving (Eq, Show, Read, Generic, Hashable, NFData) instance FromJSON ScriptOutput where parseJSON = withText "scriptoutput" $ \t -> either fail return $ diff --git a/src/Network/Haskoin/Script/SigHash.hs b/src/Network/Haskoin/Script/SigHash.hs --- a/src/Network/Haskoin/Script/SigHash.hs +++ b/src/Network/Haskoin/Script/SigHash.hs @@ -35,6 +35,7 @@ , decodeTxSig ) where +import Control.DeepSeq import Control.Monad import Crypto.Secp256k1 import qualified Data.Aeson as J @@ -47,7 +48,7 @@ import Data.Serialize import Data.Serialize.Put (runPut) import Data.Word -import GHC.Generics +import GHC.Generics (Generic) import Network.Haskoin.Constants import Network.Haskoin.Crypto.Hash import Network.Haskoin.Crypto.Signature @@ -70,6 +71,8 @@ -- ^ new inputs can be added deriving (Eq, Ord, Show, Read, Generic) +instance NFData SigHashFlag + instance Hashable SigHashFlag instance Enum SigHashFlag where @@ -100,15 +103,16 @@ SigHash Word32 deriving ( Eq , Ord - , Enum , Bits + , Enum + , Integral , Num , Real - , Integral , Show , Read , Generic , Hashable + , NFData ) instance J.FromJSON SigHash where @@ -183,7 +187,7 @@ -- | Get fork id from 'SigHash'. sigHashGetForkId :: SigHash -> Word32 -sigHashGetForkId = fromIntegral . (`shiftR` 8) +sigHashGetForkId (SigHash n) = fromIntegral $ n `shiftR` 8 -- | Computes the hash that will be used for signing a transaction. txSigHash :: Network @@ -290,12 +294,15 @@ , txSignatureSigHash :: !SigHash } | TxSignatureEmpty - deriving (Eq, Show) + deriving (Eq, Show, Generic) +instance NFData TxSignature + -- | Serialize a 'TxSignature'. encodeTxSig :: TxSignature -> ByteString encodeTxSig TxSignatureEmpty = error "Can not encode an empty signature" -encodeTxSig (TxSignature sig sh) = runPut $ putSig sig >> putWord8 (fromIntegral sh) +encodeTxSig (TxSignature sig (SigHash n)) = + runPut $ putSig sig >> putWord8 (fromIntegral n) -- | Deserialize a 'TxSignature'. decodeTxSig :: Network -> ByteString -> Either String TxSignature diff --git a/src/Network/Haskoin/Script/Standard.hs b/src/Network/Haskoin/Script/Standard.hs --- a/src/Network/Haskoin/Script/Standard.hs +++ b/src/Network/Haskoin/Script/Standard.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Network.Haskoin.Script.Standard @@ -27,11 +29,13 @@ ) where import Control.Applicative ((<|>)) +import Control.DeepSeq import Control.Monad (guard, (<=<)) import Data.ByteString (ByteString) import Data.Function (on) import Data.List (sortBy) import Data.Serialize (decode, encode) +import GHC.Generics (Generic) import Network.Haskoin.Constants import Network.Haskoin.Keys.Common import Network.Haskoin.Script.Common @@ -58,7 +62,7 @@ | SpendMulSig { getInputMulSigKeys :: ![TxSignature] -- ^ list of signatures } - deriving (Eq, Show) + deriving (Eq, Show, Generic, NFData) -- | Returns true if the input script is spending from a pay-to-public-key -- output. @@ -88,17 +92,17 @@ -- | Standard input script high-level representation. data ScriptInput - = RegularInput { - getRegularInput :: SimpleInput + = RegularInput + { getRegularInput :: !SimpleInput -- ^ get wrapped simple input - } - | ScriptHashInput { - getScriptHashInput :: SimpleInput - -- ^ get simple input associated with redeem script - , getScriptHashRedeem :: RedeemScript - -- ^ redeem script - } - deriving (Eq, Show) + } + | ScriptHashInput + { getScriptHashInput :: !SimpleInput + -- ^ get simple input associated with redeem script + , getScriptHashRedeem :: !RedeemScript + -- ^ redeem script + } + deriving (Eq, Show, Generic, NFData) -- | Heuristic to decode an input script into one of the standard types. decodeSimpleInput :: Network -> Script -> Either String SimpleInput diff --git a/src/Network/Haskoin/Test/Network.hs b/src/Network/Haskoin/Test/Network.hs --- a/src/Network/Haskoin/Test/Network.hs +++ b/src/Network/Haskoin/Test/Network.hs @@ -31,7 +31,7 @@ s <- arbitrary a <- arbitrary p <- arbitrary - NetworkAddress s <$> oneof + d <- oneof [ do b <- arbitrary c <- arbitrary @@ -39,6 +39,8 @@ return $ SockAddrInet6 (fromIntegral p) 0 (a,b,c,d) 0 , return $ SockAddrInet (fromIntegral (p :: Word16)) a ] + let n = sockToHostAddress d + return $ NetworkAddress s n -- | Arbitrary 'NetworkAddressTime'. arbitraryNetworkAddressTime :: Gen (Word32, NetworkAddress) diff --git a/src/Network/Haskoin/Transaction/Builder.hs b/src/Network/Haskoin/Transaction/Builder.hs --- a/src/Network/Haskoin/Transaction/Builder.hs +++ b/src/Network/Haskoin/Transaction/Builder.hs @@ -43,6 +43,7 @@ ) where import Control.Arrow (first) +import Control.DeepSeq import Control.Monad (foldM, mzero, unless, when) import Control.Monad.Identity (runIdentity) import Crypto.Secp256k1 @@ -277,7 +278,7 @@ , sigInputOP :: !OutPoint -- ^ outpoint to spend , sigInputSH :: !SigHash -- ^ signature type , sigInputRedeem :: !(Maybe RedeemScript) -- ^ redeem script - } deriving (Eq, Show, Read, Generic, Hashable) + } deriving (Eq, Show, Read, Generic, Hashable, NFData) instance ToJSON SigInput where toJSON (SigInput so val op sh rdm) = object $ diff --git a/src/Network/Haskoin/Transaction/Common.hs b/src/Network/Haskoin/Transaction/Common.hs --- a/src/Network/Haskoin/Transaction/Common.hs +++ b/src/Network/Haskoin/Transaction/Common.hs @@ -29,6 +29,7 @@ ) where import Control.Applicative ((<|>)) +import Control.DeepSeq import Control.Monad (forM_, guard, liftM2, mzero, replicateM, (<=<)) import Data.Aeson as A @@ -41,7 +42,7 @@ import Data.String.Conversions (cs) import Data.Text (Text) import Data.Word (Word32, Word64) -import GHC.Generics +import GHC.Generics (Generic) import Network.Haskoin.Crypto.Hash import Network.Haskoin.Network.Common import Network.Haskoin.Script.Common @@ -50,7 +51,7 @@ -- | Transaction id: hash of transaction excluding witness data. newtype TxHash = TxHash { getTxHash :: Hash256 } - deriving (Eq, Ord, Generic, Hashable, Serialize) + deriving (Eq, Ord, Generic, Hashable, Serialize, NFData) instance Show TxHash where showsPrec _ = shows . txHashToHex @@ -109,7 +110,7 @@ , txWitness :: !WitnessData -- | earliest mining height or time , txLockTime :: !Word32 - } deriving (Show, Read, Eq, Ord, Generic, Hashable) + } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) -- | Compute transaction hash. txHash :: Tx -> TxHash @@ -219,7 +220,7 @@ , scriptInput :: !ByteString -- | lock-time using sequence numbers (BIP-68) , txInSequence :: !Word32 - } deriving (Eq, Show, Read, Ord, Generic, Hashable) + } deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData) instance Serialize TxIn where get = @@ -240,7 +241,7 @@ outValue :: !Word64 -- | pubkey script , scriptOutput :: !ByteString - } deriving (Eq, Show, Read, Ord, Generic, Hashable) + } deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData) instance Serialize TxOut where get = do @@ -259,7 +260,7 @@ outPointHash :: !TxHash -- | position of output in previous transaction , outPointIndex :: !Word32 - } deriving (Show, Read, Eq, Ord, Generic, Hashable) + } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) instance FromJSON OutPoint where parseJSON = withText "OutPoint" $ diff --git a/src/Network/Haskoin/Transaction/Partial.hs b/src/Network/Haskoin/Transaction/Partial.hs --- a/src/Network/Haskoin/Transaction/Partial.hs +++ b/src/Network/Haskoin/Transaction/Partial.hs @@ -30,6 +30,7 @@ ) where import Control.Applicative ((<|>)) +import Control.DeepSeq import Control.Monad (guard, replicateM, void) import Data.ByteString (ByteString) import qualified Data.ByteString as B @@ -64,8 +65,10 @@ , globalUnknown :: UnknownMap , inputs :: [Input] , outputs :: [Output] - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) +instance NFData PartiallySignedTransaction + -- | Inputs contain all of the data needed to sign a transaction and all of the resulting signature data after signing. data Input = Input { nonWitnessUtxo :: Maybe Tx @@ -78,27 +81,35 @@ , finalScriptSig :: Maybe Script , finalScriptWitness :: Maybe WitnessStack , inputUnknown :: UnknownMap - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) +instance NFData Input + -- | Outputs can contain information needed to spend the output at a later date. data Output = Output { outputRedeemScript :: Maybe Script , outputWitnessScript :: Maybe Script , outputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex]) , outputUnknown :: UnknownMap - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) +instance NFData Output + -- | A map of raw PSBT keys to byte strings for extra data. The 'keyType' field cannot overlap with any of the reserved -- 'keyType' fields specified in the PSBT specification. newtype UnknownMap = UnknownMap { unknownMap :: HashMap Key ByteString } - deriving (Show, Eq, Semigroup, Monoid) + deriving (Show, Eq, Semigroup, Monoid, Generic) +instance NFData UnknownMap + -- | Raw keys for the map type used in PSBTs. data Key = Key { keyType :: Word8 , key :: ByteString } deriving (Show, Eq, Generic) +instance NFData Key + instance Hashable Key -- | Take two 'PartiallySignedTransaction's and merge them. The 'unsignedTransaction' field in both must be the same. @@ -377,14 +388,18 @@ | InBIP32Derivation | InFinalScriptSig | InFinalScriptWitness - deriving (Show, Eq, Enum, Bounded) + deriving (Show, Eq, Enum, Bounded, Generic) +instance NFData InputType + data OutputType = OutRedeemScript | OutWitnessScript | OutBIP32Derivation - deriving (Show, Eq, Enum, Bounded) + deriving (Show, Eq, Enum, Bounded, Generic) +instance NFData OutputType + getInputItem :: Int -> Input -> InputType -> Get Input getInputItem 0 input@Input{nonWitnessUtxo = Nothing} InNonWitnessUtxo = do utxo <- getSizedBytes @@ -446,19 +461,24 @@ putHDPath t = putPubKeyMap t . fmap PSBTHDPath newtype PSBTHDPath = PSBTHDPath { unPSBTHDPath :: (Fingerprint, [KeyIndex]) } - deriving (Show, Eq) + deriving (Show, Eq, Generic) +instance NFData PSBTHDPath + instance Serialize PSBTHDPath where get = do VarInt valueSize <- get guard $ valueSize `mod` 4 == 0 let numIndices = (fromIntegral valueSize - 4) `div` 4 - PSBTHDPath <$> isolate (fromIntegral valueSize) ((,) <$> getWord32le <*> getKeyIndexList numIndices) + PSBTHDPath <$> + isolate + (fromIntegral valueSize) + ((,) <$> getWord32le <*> getKeyIndexList numIndices) where getKeyIndexList n = replicateM n getWord32le - put (PSBTHDPath (fp, kis)) = putVarInt (B.length bs) >> putByteString bs - where bs = runPut $ putWord32le fp >> mapM_ putWord32le kis + where + bs = runPut $ putWord32le fp >> mapM_ putWord32le kis putPubKeyMap :: (Serialize a, Enum t) => t -> HashMap PubKeyI a -> Put putPubKeyMap t = void . HashMap.traverseWithKey putItem diff --git a/test/Network/Haskoin/Transaction/PartialSpec.hs b/test/Network/Haskoin/Transaction/PartialSpec.hs --- a/test/Network/Haskoin/Transaction/PartialSpec.hs +++ b/test/Network/Haskoin/Transaction/PartialSpec.hs @@ -2,6 +2,7 @@ module Network.Haskoin.Transaction.PartialSpec (spec) where +import Control.Monad.Fail (MonadFail) import Data.ByteString (ByteString) import Data.Either (fromRight, isLeft, isRight) @@ -145,7 +146,7 @@ decodeHexPSBT :: Text -> Either String PartiallySignedTransaction decodeHexPSBT = S.decode . fromJust . decodeHex -decodeHexPSBTM :: Monad m => String -> Text -> m PartiallySignedTransaction +decodeHexPSBTM :: (Monad m, MonadFail m) => String -> Text -> m PartiallySignedTransaction decodeHexPSBTM errMsg = either (fail . (errMsg <>) . (": " <>)) return . decodeHexPSBT hexScript :: Text -> ByteString