haskoin-core 0.13.4 → 0.13.5
raw patch · 21 files changed
+500/−376 lines, 21 files
Files
- CHANGELOG.md +4/−0
- haskoin-core.cabal +2/−2
- src/Haskoin/Address.hs +2/−5
- src/Haskoin/Block/Common.hs +104/−104
- src/Haskoin/Block/Headers.hs +2/−2
- src/Haskoin/Keys/Extended.hs +50/−40
- src/Haskoin/Script/Common.hs +5/−3
- src/Haskoin/Script/Standard.hs +27/−29
- src/Haskoin/Transaction/Builder.hs +36/−22
- src/Haskoin/Transaction/Builder/Sign.hs +36/−30
- src/Haskoin/Transaction/Common.hs +68/−17
- src/Haskoin/Transaction/Segwit.hs +14/−5
- test/Haskoin/AddressSpec.hs +10/−10
- test/Haskoin/BlockSpec.hs +9/−19
- test/Haskoin/Keys/ExtendedSpec.hs +57/−38
- test/Haskoin/Keys/MnemonicSpec.hs +0/−4
- test/Haskoin/NetworkSpec.hs +3/−9
- test/Haskoin/ScriptSpec.hs +6/−15
- test/Haskoin/Test/Transaction.hs +5/−2
- test/Haskoin/TransactionSpec.hs +11/−14
- test/Haskoin/UtilSpec.hs +49/−6
CHANGELOG.md view
@@ -4,6 +4,10 @@ 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.13.5+### Changed+- Provide meaningful JSON instances for most types.+ ## 0.13.4 ### Added - Support for Bitcoin Cash May 2020 hard fork.
haskoin-core.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ee5ff7456453fe4afdfd49adb164df9da4ea7368e9f8a04d4d4315b2d29a14ab+-- hash: 9d9195e4ebe6a0ef3c20fc7252c63ad4bca7d0844dfaf15f479f7e08fc98b009 name: haskoin-core-version: 0.13.4+version: 0.13.5 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
src/Haskoin/Address.hs view
@@ -139,10 +139,7 @@ addrToJSON net a = toJSON (addrToString net a) addrToEncoding :: Network -> Address -> Encoding-addrToEncoding net a =- case addrToString net a of- Nothing -> null_- Just txt -> text txt+addrToEncoding net = maybe null_ text . addrToString net -- | JSON parsing for Bitcoin addresses. Works with 'Base58', 'CashAddr' and -- 'Bech32'.@@ -151,7 +148,7 @@ withText "address" $ \t -> case stringToAddr net t of Nothing -> fail "could not decode address"- Just x -> return x+ Just x -> return x -- | Convert address to human-readable string. Uses 'Base58', 'Bech32', or -- 'CashAddr' depending on network.
src/Haskoin/Block/Common.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} {-| Module : Haskoin.Block.Common Copyright : No rights reserved@@ -32,8 +33,9 @@ import Control.DeepSeq import Control.Monad (forM_, liftM2, mzero, replicateM) import Data.Aeson (FromJSON (..), ToJSON (..),- Value (String), toJSON, withText)-import Data.Aeson.Encoding (unsafeToEncoding)+ Value (..), object, toJSON,+ withObject, withText, (.:), (.=))+import Data.Aeson.Encoding (pairs, unsafeToEncoding) import Data.Bits (shiftL, shiftR, (.&.), (.|.)) import qualified Data.ByteString as B import Data.ByteString.Builder (char7)@@ -61,16 +63,17 @@ type Timestamp = Word32 -- | Block header and transactions.-data Block =- Block { blockHeader :: !BlockHeader- , blockTxns :: ![Tx]- } deriving (Eq, Show, Read, Generic, Hashable, NFData)+data Block = Block+ { blockHeader :: !BlockHeader+ , blockTxns :: ![Tx]+ }+ deriving (Eq, Show, Read, Generic, Hashable, NFData) instance Serialize Block where get = do- header <- get+ header <- get (VarInt c) <- get- txs <- replicateM (fromIntegral c) get+ txs <- replicateM (fromIntegral c) get return $ Block header txs put (Block h txs) = do put h@@ -78,41 +81,18 @@ forM_ txs put instance ToJSON Block where- toJSON = String . encodeHex . encode- toEncoding s =- unsafeToEncoding $ char7 '"' <> hexBuilder (encode s) <> char7 '"'+ toJSON (Block h t) = object ["header" .= h, "transactions" .= t]+ toEncoding (Block h t) = pairs $ "header" .= h <> "transactions" .= t instance FromJSON Block where parseJSON =- withText "Block" $ \t -> do- bin <-- case decodeHex t of- Nothing -> mzero- Just bin -> return bin- case decode bin of- Left e -> fail e- Right h -> return h--instance ToJSON BlockHeader where- toJSON = String . encodeHex . encode- toEncoding s =- unsafeToEncoding $ char7 '"' <> hexBuilder (encode s) <> char7 '"'--instance FromJSON BlockHeader where- parseJSON =- withText "BlockHeader" $ \t -> do- bin <-- case decodeHex t of- Nothing -> mzero- Just bin -> return bin- case decode bin of- Left e -> fail e- Right h -> return h+ withObject "Block" $ \o ->+ Block <$> o .: "header" <*> o .: "transactions" -- | Block header hash. To be serialized reversed for display purposes. newtype BlockHash = BlockHash- { getBlockHash :: Hash256 }- deriving (Eq, Ord, Generic, Hashable, Serialize, NFData)+ { getBlockHash :: Hash256+ } deriving (Eq, Ord, Generic, Hashable, Serialize, NFData) instance Show BlockHash where showsPrec _ = shows . blockHashToHex@@ -128,14 +108,14 @@ in fromMaybe e $ hexToBlockHash $ cs s instance FromJSON BlockHash where- parseJSON = withText "block hash" $+ parseJSON = withText "BlockHash" $ maybe mzero return . hexToBlockHash instance ToJSON BlockHash where toJSON = String . blockHashToHex- toEncoding s =+ toEncoding h = unsafeToEncoding $- char7 '"' <> hexBuilder (B.reverse (encode s)) <> char7 '"'+ char7 '"' <> hexBuilder (B.reverse (encode h)) <> char7 '"' -- | Block hashes are reversed with respect to the in-memory byte order in a -- block hash when displayed.@@ -156,25 +136,54 @@ -- 'BlockHeader' and/or additional entropy in the coinbase 'Transaction' of this -- 'Block'. Variations in the coinbase will result in different merkle roots in -- the 'BlockHeader'.-data BlockHeader =- BlockHeader { blockVersion :: !Word32 -- 4 bytes- -- | hash of the previous block (parent)- , prevBlock :: !BlockHash -- 32 bytes- -- | root of the merkle tree of transactions- , merkleRoot :: !Hash256 -- 32 bytes- -- | unix timestamp- , blockTimestamp :: !Timestamp -- 4 bytes- -- | difficulty target- , blockBits :: !Word32 -- 4 bytes- -- | random nonce- , bhNonce :: !Word32 -- 4 bytes- } deriving (Eq, Ord, Show, Read, Generic, Hashable, NFData)+data BlockHeader = BlockHeader+ { blockVersion :: !Word32 -- 4 bytes+ -- | hash of the previous block (parent)+ , prevBlock :: !BlockHash -- 32 bytes+ -- | root of the merkle tree of transactions+ , merkleRoot :: !Hash256 -- 32 bytes+ -- | unix timestamp+ , blockTimestamp :: !Timestamp -- 4 bytes+ -- | difficulty target+ , blockBits :: !Word32 -- 4 bytes+ -- | random nonce+ , bhNonce :: !Word32 -- 4 bytes+ }+ deriving (Eq, Ord, Show, Read, Generic, Hashable, NFData) -- 80 bytes --- | Compute hash of 'BlockHeader'.-headerHash :: BlockHeader -> BlockHash-headerHash = BlockHash . doubleSHA256 . encode+instance ToJSON BlockHeader where+ toJSON (BlockHeader v p m t b n) =+ object+ [ "version" .= v+ , "prevblock" .= p+ , "merkleroot" .= encodeHex (encode m)+ , "timestamp" .= t+ , "bits" .= b+ , "nonce" .= n+ ]+ toEncoding (BlockHeader v p m t b n) =+ pairs+ ( "version" .= v+ <> "prevblock" .= p+ <> "merkleroot" .= encodeHex (encode m)+ <> "timestamp" .= t+ <> "bits" .= b+ <> "nonce" .= n+ ) +instance FromJSON BlockHeader where+ parseJSON =+ withObject "BlockHeader" $ \o ->+ BlockHeader <$> o .: "version"+ <*> o .: "prevblock"+ <*> (f =<< o .: "merkleroot")+ <*> o .: "timestamp"+ <*> o .: "bits"+ <*> o .: "nonce"+ where+ f = maybe mzero return . (eitherToMaybe . decode =<<) . decodeHex+ instance Serialize BlockHeader where get = do v <- getWord32le@@ -183,23 +192,27 @@ t <- getWord32le b <- getWord32le n <- getWord32le- return BlockHeader- { blockVersion = v- , prevBlock = p- , merkleRoot = m- , blockTimestamp = t- , blockBits = b- , bhNonce = n- }-+ return+ BlockHeader+ { blockVersion = v+ , prevBlock = p+ , merkleRoot = m+ , blockTimestamp = t+ , blockBits = b+ , bhNonce = n+ } put (BlockHeader v p m bt bb n) = do putWord32le v- put p- put m+ put p+ put m putWord32le bt putWord32le bb putWord32le n +-- | Compute hash of 'BlockHeader'.+headerHash :: BlockHeader -> BlockHash+headerHash = BlockHash . doubleSHA256 . encode+ -- | A block locator is a set of block headers, denser towards the best block -- and sparser towards the genesis block. It starts at the highest block known. -- It is used by a node to synchronize against the network. When the locator is@@ -214,23 +227,19 @@ -- missing. The number of block hashes in that inv message will end at the stop -- block hash, at at the tip of the chain, or after 500 entries, whichever comes -- earlier.-data GetBlocks =- GetBlocks { -- | protocol version.- getBlocksVersion :: !Word32- -- | block locator object- , getBlocksLocator :: !BlockLocator- -- | hash of the last desired block- , getBlocksHashStop :: !BlockHash- } deriving (Eq, Show, Generic, NFData)+data GetBlocks = GetBlocks+ { getBlocksVersion :: !Word32+ -- | block locator object+ , getBlocksLocator :: !BlockLocator+ -- | hash of the last desired block+ , getBlocksHashStop :: !BlockHash+ }+ deriving (Eq, Show, Generic, NFData) instance Serialize GetBlocks where-- get = GetBlocks <$> getWord32le- <*> (repList =<< get)- <*> get+ get = GetBlocks <$> getWord32le <*> (repList =<< get) <*> get where repList (VarInt c) = replicateM (fromIntegral c) get- put (GetBlocks v xs h) = putGetBlockMsg v xs h putGetBlockMsg :: Word32 -> BlockLocator -> BlockHash -> Put@@ -245,24 +254,19 @@ -- containing a list of block headers. A maximum of 2000 block headers can be -- returned. 'GetHeaders' is used by simplified payment verification (SPV) -- clients to exclude block contents when synchronizing the block chain.-data GetHeaders =- GetHeaders {- -- | protocol version- getHeadersVersion :: !Word32- -- | block locator object- , getHeadersBL :: !BlockLocator- -- | hash of the last desired block header- , getHeadersHashStop :: !BlockHash- } deriving (Eq, Show, Generic, NFData)+data GetHeaders = GetHeaders+ { getHeadersVersion :: !Word32+ -- | block locator object+ , getHeadersBL :: !BlockLocator+ -- | hash of the last desired block header+ , getHeadersHashStop :: !BlockHash+ }+ deriving (Eq, Show, Generic, NFData) instance Serialize GetHeaders where-- get = GetHeaders <$> getWord32le- <*> (repList =<< get)- <*> get+ get = GetHeaders <$> getWord32le <*> (repList =<< get) <*> get where repList (VarInt c) = replicateM (fromIntegral c) get- put (GetHeaders v xs h) = putGetBlockMsg v xs h -- | 'BlockHeader' type with a transaction count as 'VarInt'@@ -270,22 +274,18 @@ -- | The 'Headers' type is used to return a list of block headers in -- response to a 'GetHeaders' message.-newtype Headers =- Headers { -- | list of block headers with transaction count- headersList :: [BlockHeaderCount]- }- deriving (Eq, Show, Generic, NFData)+newtype Headers = Headers -- | list of block headers with transaction count+ { headersList :: [BlockHeaderCount]+ } deriving (Eq, Show, Generic, NFData) instance Serialize Headers where- get = Headers <$> (repList =<< get) where repList (VarInt c) = replicateM (fromIntegral c) action action = liftM2 (,) get get- put (Headers xs) = do putVarInt $ length xs- forM_ xs $ \(a,b) -> put a >> put b+ forM_ xs $ \(a, b) -> put a >> put b -- | Decode the compact number used in the difficulty target of a block. --
src/Haskoin/Block/Headers.hs view
@@ -314,8 +314,8 @@ -> m (Maybe BlockNode) parentBlock bh = getBlockHeader (prevBlock bh) --- | Validate and connect single block header to the block chain. Return 'Left' if fails--- to be validated.+-- | Validate and connect single block header to the block chain. Return 'Left'+-- if fails to be validated. connectBlock :: BlockHeaders m => Network
src/Haskoin/Keys/Extended.hs view
@@ -170,6 +170,14 @@ xPrvToEncoding :: Network -> XPrvKey -> Encoding xPrvToEncoding net = text . xPrvExport net +-- | Decode an extended private key from a JSON string+xPrvFromJSON :: Network -> Value -> Parser XPrvKey+xPrvFromJSON net =+ withText "xprv" $ \t ->+ case xPrvImport net t of+ Nothing -> fail "could not read xprv"+ Just x -> return x+ -- | Data type representing an extended BIP32 public key. data XPubKey = XPubKey { xPubDepth :: !Word8 -- ^ depth in the tree@@ -179,7 +187,6 @@ , xPubKey :: !PubKey -- ^ public key of this node } deriving (Generic, Eq, Show, Read, NFData) - -- | Decode an extended public key from a JSON string xPubFromJSON :: Network -> Value -> Parser XPubKey xPubFromJSON net =@@ -195,14 +202,6 @@ xPubToEncoding :: Network -> XPubKey -> Encoding xPubToEncoding net = text . xPubExport net --- | Decode an extended private key from a JSON string-xPrvFromJSON :: Network -> Value -> Parser XPrvKey-xPrvFromJSON net =- withText "xprv" $ \t ->- case xPrvImport net t of- Nothing -> fail "could not read xprv"- Just x -> return x- -- | Build a BIP32 compatible extended private key from a bytestring. This will -- produce a root node (@depth=0@ and @parent=0@). makeXPrvKey :: ByteString -> XPrvKey@@ -358,46 +357,46 @@ -- | Parse a binary extended private key. getXPrvKey :: Network -> Get XPrvKey getXPrvKey net = do- ver <- getWord32be- unless (ver == getExtSecretPrefix net) $ fail- "Get: Invalid version for extended private key"- XPrvKey <$> getWord8- <*> getWord32be- <*> getWord32be- <*> S.get- <*> getPadPrvKey+ ver <- getWord32be+ unless (ver == getExtSecretPrefix net) $ fail+ "Get: Invalid version for extended private key"+ XPrvKey <$> getWord8+ <*> getWord32be+ <*> getWord32be+ <*> S.get+ <*> getPadPrvKey -- | Serialize an extended private key. putXPrvKey :: Network -> Putter XPrvKey putXPrvKey net k = do- putWord32be $ getExtSecretPrefix net- putWord8 $ xPrvDepth k- putWord32be $ xPrvParent k- putWord32be $ xPrvIndex k- put $ xPrvChain k- putPadPrvKey $ xPrvKey k+ putWord32be $ getExtSecretPrefix net+ putWord8 $ xPrvDepth k+ putWord32be $ xPrvParent k+ putWord32be $ xPrvIndex k+ put $ xPrvChain k+ putPadPrvKey $ xPrvKey k -- | Parse a binary extended public key. getXPubKey :: Network -> Get XPubKey getXPubKey net = do- ver <- getWord32be- unless (ver == getExtPubKeyPrefix net) $ fail- "Get: Invalid version for extended public key"- XPubKey <$> getWord8- <*> getWord32be- <*> getWord32be- <*> S.get- <*> (pubKeyPoint <$> S.get)+ ver <- getWord32be+ unless (ver == getExtPubKeyPrefix net) $ fail+ "Get: Invalid version for extended public key"+ XPubKey <$> getWord8+ <*> getWord32be+ <*> getWord32be+ <*> S.get+ <*> (pubKeyPoint <$> S.get) -- | Serialize an extended public key. putXPubKey :: Network -> Putter XPubKey putXPubKey net k = do- putWord32be $ getExtPubKeyPrefix net- putWord8 $ xPubDepth k- putWord32be $ xPubParent k- putWord32be $ xPubIndex k- put $ xPubChain k- put $ wrapPubKey True (xPubKey k)+ putWord32be $ getExtPubKeyPrefix net+ putWord8 $ xPubDepth k+ putWord32be $ xPubParent k+ putWord32be $ xPubIndex k+ put $ xPubChain k+ put $ wrapPubKey True (xPubKey k) {- Derivation helpers -} @@ -541,8 +540,8 @@ 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 (a :| b) = rnf a `seq` rnf b+ rnf (a :/ b) = rnf a `seq` rnf b rnf Deriv = () instance Eq (DerivPathI t) where@@ -568,11 +567,18 @@ Deriv `compare` _ = LT _ `compare` Deriv = GT - instance Serialize DerivPath where get = listToPath <$> S.get put = put . pathToList +instance Serialize HardPath where+ get = maybe mzero return . toHard . listToPath =<< S.get+ put = put . pathToList++instance Serialize SoftPath where+ get = maybe mzero return . toSoft . listToPath =<< S.get+ put = put . pathToList+ -- | Get a list of derivation indices from a derivation path. pathToList :: DerivPathI t -> [KeyIndex] pathToList =@@ -729,11 +735,15 @@ instance ToJSON (DerivPathI t) where toJSON = A.String . cs . pathToStr+ toEncoding = text . cs . pathToStr instance ToJSON ParsedPath where toJSON (ParsedPrv p) = A.String . cs . ("m" ++) . pathToStr $ p toJSON (ParsedPub p) = A.String . cs . ("M" ++) . pathToStr $ p toJSON (ParsedEmpty p) = A.String . cs . ("" ++) . pathToStr $ p+ toEncoding (ParsedPrv p) = text . cs . ("m" ++) . pathToStr $ p+ toEncoding (ParsedPub p) = text . cs . ("M" ++) . pathToStr $ p+ toEncoding (ParsedEmpty p) = text . cs . ("" ++) . pathToStr $ p {- Parsing derivation paths of the form m/1/2'/3 or M/1/2'/3 -}
src/Haskoin/Script/Common.hs view
@@ -618,9 +618,11 @@ deriving (Eq, Show, Read, Generic, Hashable, NFData) instance FromJSON ScriptOutput where- parseJSON = withText "scriptoutput" $ \t -> either fail return $- maybeToEither "scriptoutput not hex" (decodeHex t) >>=- decodeOutputBS+ parseJSON =+ withText "scriptoutput" $ \t ->+ either fail return $+ maybeToEither "scriptoutput not hex" (decodeHex t) >>=+ decodeOutputBS instance ToJSON ScriptOutput where toJSON = String . encodeHex . encodeOutputBS
src/Haskoin/Script/Standard.hs view
@@ -48,21 +48,20 @@ -- provide the signing data required to unlock the coins of the output they are -- trying to spend, except in pay-to-witness-public-key-hash and -- pay-to-script-hash transactions.-data SimpleInput- -- | spend pay-to-public-key output- = SpendPK { getInputSig :: !TxSignature- -- ^ transaction signature- }- -- | spend pay-to-public-key-hash output- | SpendPKHash { getInputSig :: !TxSignature- -- ^ embedded signature- , getInputKey :: !PubKeyI- -- ^ public key- }- -- | spend multisig output- | SpendMulSig { getInputMulSigKeys :: ![TxSignature]- -- ^ list of signatures- }+data SimpleInput = SpendPK+ { getInputSig :: !TxSignature+ -- ^ transaction signature+ }+ | SpendPKHash+ { getInputSig :: !TxSignature+ -- ^ embedded signature+ , getInputKey :: !PubKeyI+ -- ^ public key+ }+ | SpendMulSig+ { getInputMulSigKeys :: ![TxSignature]+ -- ^ list of signatures+ } deriving (Eq, Show, Generic, NFData) -- | Returns true if the input script is spending from a pay-to-public-key@@ -92,17 +91,16 @@ type RedeemScript = ScriptOutput -- | Standard input script high-level representation.-data ScriptInput- = RegularInput- { getRegularInput :: !SimpleInput- -- ^ get wrapped simple input- }+data ScriptInput = RegularInput+ { getRegularInput :: !SimpleInput+ -- ^ get wrapped simple input+ } | ScriptHashInput- { getScriptHashInput :: !SimpleInput- -- ^ get simple input associated with redeem script- , getScriptHashRedeem :: !RedeemScript- -- ^ redeem script- }+ { 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.@@ -111,7 +109,7 @@ maybeToEither errMsg $ matchPK ops <|> matchPKHash ops <|> matchMulSig ops where matchPK [op] = SpendPK <$> f op- matchPK _ = Nothing+ matchPK _ = Nothing matchPKHash [op, OP_PUSHDATA pub _] = SpendPKHash <$> f op <*> eitherToMaybe (decode pub) matchPKHash _ = Nothing@@ -119,10 +117,10 @@ guard $ x == OP_0 SpendMulSig <$> mapM f xs matchMulSig _ = Nothing- f OP_0 = return TxSignatureEmpty+ f OP_0 = return TxSignatureEmpty f (OP_PUSHDATA "" OPCODE) = f OP_0- f (OP_PUSHDATA bs _) = eitherToMaybe $ decodeTxSig net bs- f _ = Nothing+ f (OP_PUSHDATA bs _) = eitherToMaybe $ decodeTxSig net bs+ f _ = Nothing errMsg = "decodeInput: Could not decode script input" -- | Heuristic to decode a 'ScriptInput' from a 'Script'. This function fails if
src/Haskoin/Transaction/Builder.hs view
@@ -320,18 +320,21 @@ -- | Merge partially-signed multisig transactions. This function does not -- support segwit and P2SH-segwit inputs. Use PSBTs to merge transactions with -- segwit inputs.-mergeTxs :: Network -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx+mergeTxs ::+ Network -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx mergeTxs net txs os | null txs = Left "Transaction list is empty" | length (nub emptyTxs) /= 1 = Left "Transactions do not match" | length txs == 1 = return $ head txs | otherwise = foldM (mergeTxInput net txs) (head emptyTxs) outs where- zipOp = zip (matchTemplate os (txIn $ head txs) f) [0..]- outs = map (first $ (\(o,v,_) -> (o,v)) . fromJust) $ filter (isJust . fst) zipOp+ zipOp = zip (matchTemplate os (txIn $ head txs) f) [0 ..]+ outs =+ map (first $ (\(o, v, _) -> (o, v)) . fromJust) $+ filter (isJust . fst) zipOp f (_, _, o) txin = o == prevOutput txin emptyTxs = map (\tx -> foldl clearInput tx outs) txs- ins is i = updateIndex i is (\ti -> ti{ scriptInput = B.empty })+ ins is i = updateIndex i is (\ti -> ti {scriptInput = B.empty}) clearInput tx (_, i) = Tx (txVersion tx) (ins (txIn tx) i) (txOut tx) [] (txLockTime tx) @@ -349,7 +352,7 @@ let ins = map (scriptInput . (!! i) . txIn) txs sigRes <- mapM extractSigs $ filter (not . B.null) ins let rdm = snd $ head sigRes- unless (all (== rdm) $ map snd sigRes) $ Left "Redeem scripts do not match"+ unless (all ((== rdm) . snd) sigRes) $ Left "Redeem scripts do not match" si <- encodeInputBS <$> go (nub $ concatMap fst sigRes) so rdm let ins' = updateIndex i (txIn tx) (\ti -> ti {scriptInput = si}) return $ Tx (txVersion tx) ins' (txOut tx) [] (txLockTime tx)@@ -390,16 +393,34 @@ where f (_, _, o) txin = o == prevOutput txin go (Just (so, val, _), i) = verifyStdInput net tx i so val- go _ = False+ go _ = False -- | Verify if a transaction input is valid and standard. verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool verifyStdInput net tx i so0 val- | isSegwit so0 = fromRight False $ (inp == mempty &&) . verifySegwitInput so0 <$> wp so0- | otherwise = fromRight False- $ verifyLegacyInput so0 <$> decodeInputBS net inp- <|> (nestedScriptOutput >>= \so -> verifyNestedInput so0 so <$> wp so)+ | isSegwit so0 =+ fromRight False $ (inp == mempty &&) . verifySegwitInput so0 <$> wp so0+ | otherwise =+ fromRight False $+ (verifyLegacyInput so0 <$> decodeInputBS net inp) <|>+ (nestedScriptOutput >>= \so -> verifyNestedInput so0 so <$> wp so) where+ inp = scriptInput $ txIn tx !! i+ theTxSigHash so = S.makeSigHash net tx i so val++ ws :: WitnessStack+ ws | length (txWitness tx) > i = txWitness tx !! i+ | otherwise = []++ wp :: ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)+ wp so = decodeWitnessInput net =<< viewWitnessProgram net so ws++ nestedScriptOutput :: Either String ScriptOutput+ nestedScriptOutput = scriptOps <$> decode inp >>= \case+ [OP_PUSHDATA bs _] -> decodeOutputBS bs+ _ -> Left "nestedScriptOutput: not a nested output"++ verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool verifyLegacyInput so si = case (so, si) of (PayPK pub, RegularInput (SpendPK (TxSignature sig sh))) -> verifyHashSig (theTxSigHash so sh Nothing) sig (pubKeyPoint pub)@@ -413,6 +434,8 @@ _ -> False where out = encodeOutput so + verifySegwitInput ::+ ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool verifySegwitInput so (rdm, si) = case (so, rdm, si) of (PayWitnessPKHash h, Nothing, SpendPKHash (TxSignature sig sh) pub) -> pubKeyWitnessAddr pub == p2wpkhAddr h &&@@ -429,20 +452,11 @@ countMulSig' (\sh -> theTxSigHash so sh $ Just rdm') (pubKeyPoint <$> pubs) sigs == r _ -> False + verifyNestedInput ::+ ScriptOutput -> ScriptOutput -> (Maybe RedeemScript, SimpleInput) -> Bool verifyNestedInput so so' x = case so of PayScriptHash h -> payToScriptAddress so' == p2shAddr h && verifySegwitInput so' x- _ -> False-- inp = scriptInput $ txIn tx !! i- theTxSigHash so = S.makeSigHash net tx i so val-- ws | length (txWitness tx) > i = txWitness tx !! i- | otherwise = []- wp so = decodeWitnessInput net =<< viewWitnessProgram net so ws-- nestedScriptOutput = scriptOps <$> decode inp >>= \case- [OP_PUSHDATA bs _] -> decodeOutputBS bs- _ -> Left "nestedScriptOutput: not a nested output"+ _ -> False -- | Count the number of valid signatures for a multi-signature transaction. countMulSig ::
src/Haskoin/Transaction/Builder/Sign.hs view
@@ -24,10 +24,10 @@ ) where import Control.DeepSeq (NFData)-import Control.Monad (foldM, mzero, when)-import Data.Aeson (FromJSON, ToJSON (..),- Value (Object), object, pairs,- parseJSON, (.:), (.:?), (.=))+import Control.Monad (foldM, when)+import Data.Aeson (FromJSON, ToJSON (..), object,+ pairs, parseJSON, withObject, (.:),+ (.:?), (.=)) import Data.Either (rights) import Data.Hashable (Hashable) import Data.List (find, nub)@@ -63,37 +63,43 @@ -- required. When signing a pay to script hash output, an additional redeem -- script is required. data SigInput = SigInput- { sigInputScript :: !ScriptOutput -- ^ output script to spend- , sigInputValue :: !Word64 -- ^ output script value- , sigInputOP :: !OutPoint -- ^ outpoint to spend- , sigInputSH :: !SigHash -- ^ signature type+ { sigInputScript :: !ScriptOutput -- ^ output script to spend+ -- ^ output script value+ , sigInputValue :: !Word64 -- ^ output script value+ -- ^ outpoint to spend+ , sigInputOP :: !OutPoint -- ^ outpoint to spend+ -- ^ signature type+ , sigInputSH :: !SigHash -- ^ signature type+ -- ^ redeem script , sigInputRedeem :: !(Maybe RedeemScript) -- ^ redeem script- } deriving (Eq, Show, Read, Generic, Hashable, NFData)+ }+ deriving (Eq, Show, Read, Generic, Hashable, NFData) instance ToJSON SigInput where- toJSON (SigInput so val op sh rdm) = object $- [ "pkscript" .= so- , "value" .= val- , "outpoint" .= op- , "sighash" .= sh- ] ++ [ "redeem" .= r | r <- maybeToList rdm ]- toEncoding (SigInput so val op sh rdm) = pairs $- "pkscript" .= so- <> "value" .= val- <> "outpoint" .= op- <> "sighash" .= sh- <> (case rdm of Nothing -> mempty- Just r -> "redeem" .= r)+ toJSON (SigInput so val op sh rdm) =+ object $+ [ "pkscript" .= so+ , "value" .= val+ , "outpoint" .= op+ , "sighash" .= sh+ ] +++ [ "redeem" .= r | r <- maybeToList rdm ]+ toEncoding (SigInput so val op sh rdm) =+ pairs $+ "pkscript" .= so+ <> "value" .= val+ <> "outpoint" .= op+ <> "sighash" .= sh+ <> maybe mempty ("redeem" .=) rdm instance FromJSON SigInput where- parseJSON (Object o) = do- so <- o .: "pkscript"- val <- o .: "value"- op <- o .: "outpoint"- sh <- o .: "sighash"- rdm <- o .:? "redeem"- return $ SigInput so val op sh rdm- parseJSON _ = mzero+ parseJSON =+ withObject "SigInput" $ \o ->+ SigInput <$> o .: "pkscript"+ <*> o .: "value"+ <*> o .: "outpoint"+ <*> o .: "sighash"+ <*> o .:? "redeem" -- | Sign a transaction by providing the 'SigInput' signing parameters and a -- list of private keys. The signature is computed deterministically as defined
src/Haskoin/Transaction/Common.hs view
@@ -75,9 +75,8 @@ instance ToJSON TxHash where toJSON = A.String . txHashToHex- toEncoding (TxHash h) =- unsafeToEncoding $- char7 '"' <> hexBuilder (B.reverse (S.encode h)) <> char7 '"'+ toEncoding h =+ unsafeToEncoding $ char7 '"' <> hexBuilder (B.reverse (S.encode h)) <> char7 '"' -- | Transaction hash excluding signatures. nosigTxHash :: Tx -> TxHash@@ -211,13 +210,32 @@ putByteString bs instance FromJSON Tx where- parseJSON = withText "Tx" $- maybe mzero return . (eitherToMaybe . S.decode <=< decodeHex)+ parseJSON = withObject "Tx" $ \o ->+ Tx <$> o .: "version"+ <*> o .: "inputs"+ <*> o .: "outputs"+ <*> (mapM (mapM f) =<< o .: "witnessdata")+ <*> o .: "locktime"+ where+ f = maybe mzero return . decodeHex instance ToJSON Tx where- toJSON = A.String . encodeHex . S.encode- toEncoding tx =- unsafeToEncoding $ char7 '"' <> hexBuilder (S.encode tx) <> char7 '"'+ toJSON (Tx v i o w l) =+ object+ [ "version" .= v+ , "inputs" .= i+ , "outputs" .= o+ , "witnessdata" .= fmap (fmap encodeHex) w+ , "locktime" .= l+ ]+ toEncoding (Tx v i o w l) =+ pairs+ ( "version" .= v+ <> "inputs" .= i+ <> "outputs" .= o+ <> "witnessdata" .= fmap (fmap encodeHex) w+ <> "locktime" .= l+ ) -- | Data type representing a transaction input. data TxIn =@@ -242,6 +260,27 @@ putByteString s putWord32le q +instance FromJSON TxIn where+ parseJSON =+ withObject "TxIn" $ \o ->+ TxIn <$> o .: "prevoutput"+ <*> (maybe mzero return . decodeHex =<< o .: "inputscript")+ <*> o .: "sequence"++instance ToJSON TxIn where+ toJSON (TxIn o s q) =+ object+ [ "prevoutput" .= o+ , "inputscript" .= encodeHex s+ , "sequence" .= q+ ]+ toEncoding (TxIn o s q) =+ pairs+ ( "prevoutput" .= o+ <> "inputscript" .= encodeHex s+ <> "sequence" .= q+ )+ -- | Data type representing a transaction output. data TxOut = TxOut {@@ -262,6 +301,18 @@ putVarInt $ B.length s putByteString s +instance FromJSON TxOut where+ parseJSON =+ withObject "TxOut" $ \o ->+ TxOut <$> o .: "value"+ <*> (maybe mzero return . decodeHex =<< o .: "outputscript")++instance ToJSON TxOut where+ toJSON (TxOut o s) =+ object ["value" .= o, "outputscript" .= encodeHex s]+ toEncoding (TxOut o s) =+ pairs ("value" .= o <> "outputscript" .= encodeHex s)+ -- | The 'OutPoint' refers to a transaction output being spent. data OutPoint = OutPoint { -- | hash of previous transaction@@ -270,20 +321,20 @@ , outPointIndex :: !Word32 } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) -instance FromJSON OutPoint where- parseJSON = withText "OutPoint" $- maybe mzero return . (eitherToMaybe . S.decode <=< decodeHex)--instance ToJSON OutPoint where- toJSON = A.String . encodeHex . S.encode- toEncoding op =- unsafeToEncoding $ char7 '"' <> hexBuilder (S.encode op) <> char7 '"'- instance Serialize OutPoint where get = do (h,i) <- liftM2 (,) S.get getWord32le return $ OutPoint h i put (OutPoint h i) = put h >> putWord32le i++instance FromJSON OutPoint where+ parseJSON =+ withObject "OutPoint" $ \o ->+ OutPoint <$> o .: "txid" <*> o .: "index"++instance ToJSON OutPoint where+ toJSON (OutPoint h i) = object ["txid" .= h, "index" .= i]+ toEncoding (OutPoint h i) = pairs ("txid" .= h <> "index" .= i) -- | Outpoint used in coinbase transactions. nullOutPoint :: OutPoint
src/Haskoin/Transaction/Segwit.hs view
@@ -52,7 +52,10 @@ -- | High level represenation of a (v0) witness program -- -- @since 0.11.0.0-data WitnessProgram = P2WPKH WitnessProgramPKH | P2WSH WitnessProgramSH | EmptyWitnessProgram+data WitnessProgram+ = P2WPKH WitnessProgramPKH+ | P2WSH WitnessProgramSH+ | EmptyWitnessProgram deriving (Eq, Show) -- | Encode a witness program@@ -70,7 +73,8 @@ data WitnessProgramPKH = WitnessProgramPKH { witnessSignature :: !TxSignature , witnessPubKey :: !PubKeyI- } deriving (Eq, Show)+ }+ deriving (Eq, Show) -- | High-level representation of a P2WSH witness --@@ -78,12 +82,14 @@ data WitnessProgramSH = WitnessProgramSH { witnessScriptHashStack :: ![ByteString] , witnessScriptHashScript :: !Script- } deriving (Eq, Show)+ }+ deriving (Eq, Show) -- | Calculate the witness program from the transaction data -- -- @since 0.11.0.0-viewWitnessProgram :: Network -> ScriptOutput -> WitnessStack -> Either String WitnessProgram+viewWitnessProgram ::+ Network -> ScriptOutput -> WitnessStack -> Either String WitnessProgram viewWitnessProgram net so witness = case so of PayWitnessPKHash _ | length witness == 2 -> do sig <- decodeTxSig net $ head witness@@ -98,7 +104,10 @@ -- | Analyze the witness, trying to match it with standard input structures -- -- @since 0.11.0.0-decodeWitnessInput :: Network -> WitnessProgram -> Either String (Maybe ScriptOutput, SimpleInput)+decodeWitnessInput ::+ Network+ -> WitnessProgram+ -> Either String (Maybe ScriptOutput, SimpleInput) decodeWitnessInput net = \case P2WPKH (WitnessProgramPKH sig key) -> return (Nothing, SpendPKHash sig key) P2WSH (WitnessProgramSH st scr) -> do
test/Haskoin/AddressSpec.hs view
@@ -1,19 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} module Haskoin.AddressSpec (spec) where -import Data.Aeson-import Data.Aeson.Types import Data.ByteString (ByteString) import qualified Data.ByteString as BS (append, empty, pack)-import Data.Either (isRight) import Data.Maybe (fromJust, isJust)-import qualified Data.Serialize as S import Data.Text (Text) import Haskoin.Address-import Haskoin.Address.Base58 import Haskoin.Constants import Haskoin.Keys (derivePubKeyI) import Haskoin.Test+import Haskoin.UtilSpec (testCustomEncoding, testCustomJSON) import Test.Hspec import Test.HUnit (Assertion, assertBool, assertEqual) import Test.QuickCheck@@ -26,8 +22,15 @@ describe "bch address" $ props bch describe "bch-test address" $ props bchTest describe "bch-regtest address" $ props bchRegTest- describe "json serialization" . it "encodes and decodes address" $- forAll arbitraryAddress (testCustom (addrFromJSON net) (addrToJSON net))+ describe "json serialization" $ do+ it "encodes and decodes address (addrToJSON)" $+ forAll+ arbitraryAddress+ (testCustomJSON (addrFromJSON net) (addrToJSON net))+ it "encodes and decodes address (addrToEncoding)" $+ forAll+ arbitraryAddress+ (testCustomEncoding (addrFromJSON net) (addrToEncoding net)) describe "witness address vectors" . it "p2sh(pwpkh)" $ mapM_ testCompatWitness compatWitnessVectors @@ -69,9 +72,6 @@ , "111151KWPPBRzdWPr1ASeu172gVgLf1YfUp6VJyk6K9t4cLqYtFHcMa2iX8S3NJEprUcW7W5LvaPRpz7UG7puBj5STE3nKhCGt5eckYq7mMn5nT7oTTic2BAX6zDdqrmGCnkszQkzkz8e5QLGDjf7KeQgtEDm4UER6DMSdBjFQVa6cHrrJn9myVyyhUrsVnfUk2WmNFZvkWv3Tnvzo2cJ1xW62XDfUgYz1pd97eUGGPuXvDFfLsBVd1dfdUhPwxW7pMPgdWHTmg5uqKGFF6vE4xXpAqZTbTxRZjCDdTn68c2wrcxApm8hq3JX65Hix7VtcD13FF8b7BzBtwjXq1ze6NMjKgUcqpJTN9vt" ) ]--testCustom :: Eq a => (Value -> Parser a) -> (a -> Value) -> a -> Bool-testCustom f g x = parseMaybe f (g x) == Just x compatWitnessVectors :: [(Network, Text, Text)] compatWitnessVectors =
test/Haskoin/BlockSpec.hs view
@@ -4,20 +4,16 @@ ) where import Control.Monad.State.Strict-import Data.Aeson as A import Data.Either (fromRight)-import Data.Map.Strict (singleton) import Data.Maybe (fromJust)-import Data.Serialize as S import Data.String (fromString) import Data.String.Conversions (cs) import Data.Text (Text) import Haskoin.Block-import Haskoin.Block.Headers-import Haskoin.Block.Merkle import Haskoin.Constants import Haskoin.Test import Haskoin.Transaction+import Haskoin.UtilSpec (cerealID, testJsonID) import Test.Hspec import Test.HUnit hiding (State) import Test.QuickCheck@@ -67,7 +63,6 @@ fromString (cs $ blockHashToHex h) == h it "show and read block hash" $ property $ forAll arbitraryBlockHash $ \h -> read (show h) == h- it "json block hash" $ property $ forAll arbitraryBlockHash testID describe "merkle trees" $ do let net' = btc it "builds tree of right width at height 1" $ property testTreeWidth@@ -82,15 +77,11 @@ describe "compact number" $ do it "compact number local vectors" testCompact it "compact number imported vectors" testCompactBitcoinCore- describe "block serialization" $ do+ describe "binary block serialization" $ do it "encodes and decodes block" $ property $ forAll (arbitraryBlock net) cerealID- it "encodes and decodes block JSON" $- property $ forAll (arbitraryBlock net) testID it "encodes and decodes block header" $ property $ forAll arbitraryBlockHeader cerealID- it "encodes and decodes block header JSON" $- property $ forAll arbitraryBlockHeader testID it "encodes and decodes getblocks" $ property $ forAll arbitraryGetBlocks cerealID it "encodes and decodes getheaders" $@@ -99,6 +90,13 @@ property $ forAll arbitraryHeaders cerealID it "encodes and decodes merkle block" $ property $ forAll arbitraryMerkleBlock cerealID+ describe "JSON block serialization" $ do+ it "encodes and decodes Block" $+ property $ forAll (arbitraryBlock net) testJsonID+ it "encodes and decodes BlockHash" $+ property $ forAll arbitraryBlockHash testJsonID+ it "encodes and decodes BlockHeader" $+ property $ forAll arbitraryBlockHeader testJsonID describe "helper functions" $ do it "computes bitcoin block subsidy correctly" (testSubsidy btc) it "computes regtest block subsidy correctly" (testSubsidy btcRegTest)@@ -337,14 +335,6 @@ ] ) ]--testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool-testID x =- (A.decode . A.encode) (singleton ("object" :: String) x) ==- Just (singleton ("object" :: String) x)--cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = S.decode (S.encode x) == Right x testSubsidy :: Network -> Assertion testSubsidy net = go (2 * 50 * 100 * 1000 * 1000) 0
test/Haskoin/Keys/ExtendedSpec.hs view
@@ -2,11 +2,9 @@ module Haskoin.Keys.ExtendedSpec (spec) where import Data.Aeson as A-import Data.Aeson.Types as A import Data.Bits ((.&.)) import qualified Data.ByteString.Lazy.Char8 as B8 import Data.Either (isLeft)-import Data.Map.Strict (singleton) import Data.Maybe (fromJust, isJust, isNothing) import Data.Serialize as S import Data.String (fromString)@@ -18,6 +16,9 @@ import Haskoin.Keys import Haskoin.Test import Haskoin.Util+import Haskoin.UtilSpec (cerealID, customCerealID,+ testCustomEncoding, testCustomJSON,+ testJsonID) import Test.Hspec import Test.HUnit (Assertion, assertBool, assertEqual) import Test.QuickCheck hiding ((.&.))@@ -46,18 +47,52 @@ it "path parsing" testParsePath it "from json" testFromJsonPath it "to json" testToJsonPath- describe "extended keys" $ do+ describe "JSON Encoding" $ do let net = btc- it "computes pubkey of a subkey is subkey of the pubkey" $- property $ forAll arbitraryXPrvKey pubKeyOfSubKeyIsSubKeyOfPubKey- it "exports and imports extended private key" $+ it "encodes and decodes derivation path to JSON" $+ forAll arbitraryDerivPath testJsonID+ it "encodes and decodes hard path to JSON" $+ forAll arbitraryHardPath testJsonID+ it "encodes and decodes soft path to JSON" $+ forAll arbitrarySoftPath testJsonID+ it "encodes and decodes parsed derivation path to JSON" $+ forAll arbitraryParsedPath testJsonID+ it "encodes and decodes extended private key (JSON)" $+ forAll+ arbitraryXPrvKey+ (testCustomJSON (xPrvFromJSON net) (xPrvToJSON net))+ it "encodes and decodes extended private key (Encoding)" $+ forAll+ arbitraryXPrvKey+ (testCustomEncoding (xPrvFromJSON net) (xPrvToEncoding net))+ it "encodes and decodes extended public key (JSON)" $+ forAll+ arbitraryXPubKey+ (testCustomJSON (xPubFromJSON net) (xPubToJSON net) . snd)+ it "encodes and decodes extended public key (Encoding)" $+ forAll+ arbitraryXPubKey+ (testCustomEncoding (xPubFromJSON net) (xPubToEncoding net) . snd)+ describe "Binary Encoding" $ do+ let net = btc+ it "encodes and decodes extended private key" $ property $- forAll arbitraryXPrvKey $ \k ->- xPrvImport net (xPrvExport net k) == Just k- it "exports and imports extended public key" $+ forAll arbitraryXPrvKey $+ customCerealID (getXPrvKey net) (putXPrvKey net)+ it "encodes and decodes extended public key" $ property $- forAll arbitraryXPubKey $ \(_, k) ->- xPubImport net (xPubExport net k) == Just k+ forAll arbitraryXPubKey $+ customCerealID (getXPubKey net) (putXPubKey net) . snd+ it "Cereal encode derivation path" $+ property $ forAll arbitraryDerivPath cerealID+ it "Cereal encode hard derivation path" $+ property $ forAll arbitraryHardPath cerealID+ it "Cereal encode soft derivation path" $+ property $ forAll arbitrarySoftPath cerealID+ -- This instance does not exist. Uncomment if you add a sensible one.+ -- it "Cereal encode parsed derivation path" $+ -- property $ forAll arbitraryParsedPath cerealID+ describe "Derivation Paths" $ do it "show and read derivation path" $ property $ forAll arbitraryDerivPath $ \p -> read (show p) == p it "show and read hard derivation path" $@@ -86,22 +121,18 @@ toSoft (listToPath $ pathToList p) == Just p it "read and show parsed path" $ property $ forAll arbitraryParsedPath $ \p -> read (show p) == p- it "encodes and decodes extended private key" $- forAll- arbitraryXPrvKey- (testCustom (xPrvFromJSON net) (xPrvToJSON net))- it "encodes and decodes extended public key" $- forAll- arbitraryXPubKey- (testCustom (xPubFromJSON net) (xPubToJSON net) . snd)- it "encodes and decodes derivation path" $- forAll arbitraryDerivPath testID- it "encodes and decodes parsed derivation path" $- forAll arbitraryParsedPath testID- it "encodes and decodes extended private key" $+ describe "Extended Keys" $ do+ let net = btc+ it "computes pubkey of a subkey is subkey of the pubkey" $+ property $ forAll arbitraryXPrvKey pubKeyOfSubKeyIsSubKeyOfPubKey+ it "exports and imports extended private key" $ property $- forAll arbitraryXPrvKey $- testPutGet (getXPrvKey net) (putXPrvKey net)+ forAll arbitraryXPrvKey $ \k ->+ xPrvImport net (xPrvExport net k) == Just k+ it "exports and imports extended public key" $+ property $+ forAll arbitraryXPubKey $ \(_, k) ->+ xPubImport net (xPubExport net k) == Just k it "shows and reads extended private key" $ property $ forAll arbitraryXPrvKey $ \k -> read (show k) `shouldBe` k@@ -507,15 +538,3 @@ deriveXPubKey (prvSubKey k i') == pubSubKey (deriveXPubKey k) i' where i' = fromIntegral $ i .&. 0x7fffffff -- make it a public derivation---testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool-testID x =- (A.decode . A.encode) (singleton ("object" :: String) x) ==- Just (singleton ("object" :: String) x)--testCustom :: Eq a => (Value -> Parser a) -> (a -> Value) -> a -> Bool-testCustom f g x = parseMaybe f (g x) == Just x--testPutGet :: Eq a => Get a -> Putter a -> a -> Bool-testPutGet g p a = runGet g (runPut (p a)) == Right a
test/Haskoin/Keys/MnemonicSpec.hs view
@@ -3,18 +3,14 @@ import Control.Monad (zipWithM_) import Data.Bits (shiftR, (.&.))-import Data.ByteString (ByteString) import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as C import Data.Either (fromRight) import Data.List (isPrefixOf) import Data.Maybe (fromJust) import Data.Serialize (Serialize, encode)-import Data.String.Conversions (cs) import Data.Text (Text) import qualified Data.Text as T import Data.Word (Word32, Word64)-import Haskoin.Crypto import Haskoin.Keys import Haskoin.Test import Haskoin.Util
test/Haskoin/NetworkSpec.hs view
@@ -12,6 +12,7 @@ import Haskoin.Test import Haskoin.Transaction import Haskoin.Util+import Haskoin.UtilSpec (cerealID, customCerealID) import Test.Hspec import Test.HUnit (Assertion, assertBool, assertEqual) import Test.QuickCheck@@ -57,7 +58,7 @@ it "encodes and decodes message" $ property $ forAll (arbitraryMessage net) $- testPutGet (getMessage net) (putMessage net)+ customCerealID (getMessage net) (putMessage net) describe "serialization of bloom types" $ do it "encodes and decodes bloom flags" $ property $ forAll arbitraryBloomFlags cerealID@@ -106,12 +107,6 @@ p = derivePubKeyI k bs = fromJust $ decodeHex "038fc16b080000000000000001" -cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = S.decode (S.encode x) == Right x--testPutGet :: Eq a => Get a -> Putter a -> a -> Bool-testPutGet g p a = runGet g (runPut (p a)) == Right a- relevantOutputUpdated :: Assertion relevantOutputUpdated = assertBool "Bloom filter output updated" $ any (bloomContains bf2) spendTxInput@@ -120,7 +115,7 @@ relevantOutputHash = fromJust $ decodeHex"03f47604ea2736334151081e13265b4fe38e6fa8" bf1 = bloomInsert bf0 relevantOutputHash bf2 = fromJust $ bloomRelevantUpdate bf1 relevantTx- spendTxInput = (encode .prevOutput) <$> txIn spendRelevantTx+ spendTxInput = encode .prevOutput <$> txIn spendRelevantTx irrelevantOutputNotUpdated :: Assertion irrelevantOutputNotUpdated = assertEqual "Bloom filter not updated" Nothing bf2@@ -129,7 +124,6 @@ relevantOutputHash = fromJust $ decodeHex"03f47604ea2736334151081e13265b4fe38e6fa8" bf1 = bloomInsert bf0 relevantOutputHash bf2 = bloomRelevantUpdate bf1 unrelatedTx- spendTxInput = (encode .prevOutput) <$> txIn spendRelevantTx -- Random transaction (57dc904f32ad4daab7b321dd469e8791ad09df784cdd273a73985150a4f225e9) relevantTx :: Tx
test/Haskoin/ScriptSpec.hs view
@@ -8,7 +8,6 @@ import qualified Data.ByteString.Lazy as L import Data.Either import Data.List-import Data.Map.Strict (singleton) import Data.Maybe import Data.Serialize as S import Data.String@@ -22,6 +21,7 @@ import Haskoin.Test import Haskoin.Transaction import Haskoin.Util+import Haskoin.UtilSpec (cerealID, testJsonID) import Test.Hspec import Test.HUnit as HUnit import Test.QuickCheck@@ -38,12 +38,12 @@ zipWithM_ (curry (sigDecodeMap net)) scriptSigSignatures [0 ..] describe "json serialization" $ do it "encodes and decodes script output" $- forAll (arbitraryScriptOutput net) testID- it "encodes and decodes outpoint" $ forAll arbitraryOutPoint testID- it "encodes and decodes sighash" $ forAll arbitrarySigHash testID+ forAll (arbitraryScriptOutput net) testJsonID+ it "encodes and decodes outpoint" $ forAll arbitraryOutPoint testJsonID+ it "encodes and decodes sighash" $ forAll arbitrarySigHash testJsonID it "encodes and decodes siginput" $- forAll (arbitrarySigInput net) (testID . fst)- describe "script serialization" $ do+ forAll (arbitrarySigInput net) (testJsonID . fst)+ describe "Cereal script serialization" $ do it "encodes and decodes script op" $ property $ forAll arbitraryScriptOp cerealID it "encodes and decodes script" $@@ -59,9 +59,6 @@ sigHashSpec net txSigHashSpec net -cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = S.decode (S.encode x) == Right x- standardSpec :: Network -> Spec standardSpec net = do it "has intToScriptOp . scriptOpToInt identity" $@@ -397,9 +394,3 @@ -- decode strict signatures. -- "3048022200002b83d59c1d23c08efd82ee0662fec23309c3adbcbd1f0b8695378db4b14e736602220000334a96676e58b1bb01784cb7c556dd8ce1c220171904da22e18fe1e7d1510db501" ]---testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool-testID x =- (A.decode . A.encode) (singleton ("object" :: String) x) ==- Just (singleton ("object" :: String) x)
test/Haskoin/Test/Transaction.hs view
@@ -80,11 +80,14 @@ then 2 else 0 , 5 -- avoid witness case- )+ ) inps <- vectorOf ni (arbitraryTxIn net) outs <- vectorOf no (arbitraryTxOut net) let uniqueInps = nubBy (\a b -> prevOutput a == prevOutput b) inps- w <- if wit then vectorOf (length uniqueInps) (listOf arbitraryBS) else return []+ w <-+ if wit+ then vectorOf (length uniqueInps) (listOf arbitraryBS)+ else return [] Tx <$> arbitrary <*> pure uniqueInps <*> pure outs <*> pure w <*> arbitrary -- | Arbitrary transaction containing only inputs of type 'SpendPKHash',
test/Haskoin/TransactionSpec.hs view
@@ -2,10 +2,8 @@ module Haskoin.TransactionSpec (spec) where -import Data.Aeson as A import qualified Data.ByteString as B import Data.Either-import Data.Map.Strict (singleton) import Data.Maybe import Data.Serialize as S import Data.String (fromString)@@ -20,6 +18,7 @@ import Haskoin.Transaction import Haskoin.Transaction.Segwit (isSegwit) import Haskoin.Util+import Haskoin.UtilSpec (cerealID, testJsonID) import Safe (readMay) import Test.Hspec import Test.HUnit (Assertion, assertBool)@@ -68,12 +67,18 @@ property $ forAll (arbitrarySigningData net) (testDetSignNestedTx net) it "merge partially signed transactions" $ property $ forAll (arbitraryPartialTxs net) (testMergeTx net)- describe "json serialization" $ do+ describe "transaction JSON serialization" $ do it "encodes and decodes transaction" $- property $ forAll (arbitraryTx net) testID+ property $ forAll (arbitraryTx net) testJsonID it "encodes and decodes transaction hash" $- property $ forAll arbitraryTxHash testID- describe "transaction serialization" $ do+ property $ forAll arbitraryTxHash testJsonID+ it "encodes and decodes transaction inputs" $+ property $ forAll (arbitraryTxIn net) testJsonID+ it "encodes and decodes transaction outputs" $+ property $ forAll (arbitraryTxOut net) testJsonID+ it "encodes and decodes outpoints" $+ property $ forAll arbitraryOutPoint testJsonID+ describe "transaction binary serialization" $ do it "encodes and decodes tx input" $ property $ forAll (arbitraryTxIn net) cerealID it "encodes and decodes tx output" $@@ -87,9 +92,6 @@ it "encodes and decodes legacy transaction" $ property $ forAll (arbitraryLegacyTx net) cerealID -cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = S.decode (S.encode x) == Right x- runTxIDVec :: (Text, Text) -> Assertion runTxIDVec (tid, tx) = assertBool "txid" $ txHashToHex (txHash txBS) == tid where@@ -389,8 +391,3 @@ Right (RegularInput (SpendMulSig sigs)) -> length sigs Right (ScriptHashInput (SpendMulSig sigs) _) -> length sigs _ -> error "Invalid input script type"--testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool-testID x =- (A.decode . A.encode) (singleton ("object" :: String) x) ==- Just (singleton ("object" :: String) x)
test/Haskoin/UtilSpec.hs view
@@ -1,11 +1,24 @@-module Haskoin.UtilSpec (spec) where+module Haskoin.UtilSpec+ ( spec+ , testJsonID+ , testCustomJSON+ , testCustomEncoding+ , cerealID+ , customCerealID+ ) where -import qualified Data.ByteString as BS-import Data.Either (fromLeft, fromRight, isLeft, isRight)-import Data.Foldable (toList)-import Data.List (permutations)+import Data.Aeson (FromJSON, ToJSON)+import qualified Data.Aeson as A+import Data.Aeson.Encoding (encodingToLazyByteString)+import Data.Aeson.Types (Parser, parseMaybe)+import qualified Data.ByteString as BS+import Data.Either (fromLeft, fromRight, isLeft, isRight)+import Data.Foldable (toList)+import Data.List (permutations)+import Data.Map.Strict (singleton) import Data.Maybe-import qualified Data.Sequence as Seq+import qualified Data.Sequence as Seq+import Data.Serialize as S import Haskoin.Test import Haskoin.Util import Test.Hspec@@ -62,3 +75,33 @@ not (isRight e) && fromLeft (error "Unexpected Right") e == v && isNothing (eitherToMaybe e)++cerealID :: (Serialize a, Eq a) => a -> Bool+cerealID x = S.decode (S.encode x) == Right x++customCerealID :: Eq a => Get a -> Putter a -> a -> Bool+customCerealID g p a = runGet g (runPut (p a)) == Right a++testJsonID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool+testJsonID x = jsonID_ x && encodingID_ x++jsonID_ :: (FromJSON a, ToJSON a, Eq a) => a -> Bool+jsonID_ x =+ (A.fromJSON . A.toJSON) (singleton ("object" :: String) x) ==+ A.Success (singleton ("object" :: String) x)++encodingID_ :: (FromJSON a, ToJSON a, Eq a) => a -> Bool+encodingID_ x =+ (A.decode . encodingToLazyByteString . A.toEncoding)+ (singleton ("object" :: String) x) ==+ Just (singleton ("object" :: String) x)++testCustomJSON :: Eq a => (A.Value -> Parser a) -> (a -> A.Value) -> a -> Bool+testCustomJSON f g x = parseMaybe f (g x) == Just x++testCustomEncoding ::+ Eq a => (A.Value -> Parser a) -> (a -> A.Encoding) -> a -> Bool+testCustomEncoding f g x =+ dec (encodingToLazyByteString $ g x) == Just x+ where+ dec bs = parseMaybe f =<< A.decode bs