haskoin-core 0.6.0 → 0.6.1
raw patch · 5 files changed
+51/−39 lines, 5 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +7/−0
- haskoin-core.cabal +4/−4
- src/Network/Haskoin/Block/Headers.hs +8/−5
- src/Network/Haskoin/Test/Script.hs +27/−18
- test/Network/Haskoin/BlockSpec.hs +5/−12
CHANGELOG.md view
@@ -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.6.1+### Added+- Compatibility with latest GHC and base.++### Changed+- Update minimum base to 4.9.+ ## 0.6.0 ### Changed - Force initialization of addresses through smart constructor.
haskoin-core.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 60cf3a9fd398cb3bffeaa6d67b67e5bf4d56163b98c4137d7738ace0286ec13f+-- hash: a15368965c6befac912e285d4519667d835f4c9330b283af73a732d62915c260 name: haskoin-core-version: 0.6.0+version: 0.6.1 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@@ -81,7 +81,7 @@ QuickCheck , aeson , array- , base >=4.7 && <5+ , base >=4.9 && <5 , base16-bytestring , bytestring , cereal@@ -131,7 +131,7 @@ HUnit , QuickCheck , aeson- , base >=4.7 && <5+ , base >=4.9 && <5 , bytestring , cereal , containers
src/Network/Haskoin/Block/Headers.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-| Module : Network.Haskoin.Block.Headers@@ -278,11 +279,13 @@ (MaybeT (parentBlock bh)) pars <- lift $ getParents 10 par bb <- lift getBestBlockHeader- bns@(bn:_) <- go par [] bb par pars bhs- lift $ addBlockHeaders bns- let bb' = chooseBest bn bb- when (bb' /= bb) $ lift $ setBestBlockHeader bb'- return bns+ go par [] bb par pars bhs >>= \case+ bns@(bn:_) -> do+ lift $ addBlockHeaders bns+ let bb' = chooseBest bn bb+ when (bb' /= bb) $ lift $ setBestBlockHeader bb'+ return bns+ _ -> undefined where chained (h1:h2:hs) = headerHash h1 == prevBlock h2 && chained (h2 : hs) chained _ = True
src/Network/Haskoin/Test/Script.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-| Module : Network.Haskoin.Test.Script Copyright : No rights reserved@@ -189,10 +190,10 @@ -- private key. arbitraryTxSignature :: Network -> Gen (TxHash, SecKey, TxSignature) arbitraryTxSignature net = do- (msg, key, sig) <- arbitrarySignature+ (m, key, sig) <- arbitrarySignature sh <- (fromIntegral <$> (arbitrary :: Gen Word8)) `suchThat` filterBad let txsig = TxSignature sig sh- return (TxHash msg, key, txsig)+ return (TxHash m, key, txsig) where filterBad sh = not $ isSigHashUnknown sh ||@@ -338,29 +339,37 @@ -- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a -- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'. arbitraryMulSigSHInput :: Network -> Gen ScriptInput-arbitraryMulSigSHInput net = do- rdm@(PayMulSig _ m) <- arbitraryMSOutput- sigs <- vectorOf m (arbitraryTxSignatureEmpty net)- return $ ScriptHashInput (SpendMulSig sigs) rdm+arbitraryMulSigSHInput net =+ arbitraryMSOutput >>= \case+ rdm@(PayMulSig _ m) -> do+ sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+ return $ ScriptHashInput (SpendMulSig sigs) rdm+ _ -> undefined -- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a -- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'. arbitraryMulSigSHInputC :: Network -> Gen ScriptInput-arbitraryMulSigSHInputC net = do- rdm@(PayMulSig _ m) <- arbitraryMSOutputC- sigs <- vectorOf m (arbitraryTxSignatureEmpty net)- return $ ScriptHashInput (SpendMulSig sigs) rdm+arbitraryMulSigSHInputC net =+ arbitraryMSOutputC >>= \case+ rdm@(PayMulSig _ m) -> do+ sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+ return $ ScriptHashInput (SpendMulSig sigs) rdm+ _ -> undefined -- | Like 'arbitraryMulSigSHCInput' with no empty signatures. arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput-arbitraryMulSigSHInputFull net = do- rdm@(PayMulSig _ m) <- arbitraryMSOutput- sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)- return $ ScriptHashInput (SpendMulSig sigs) rdm+arbitraryMulSigSHInputFull net =+ arbitraryMSOutput >>= \case+ rdm@(PayMulSig _ m) -> do+ sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)+ return $ ScriptHashInput (SpendMulSig sigs) rdm+ _ -> undefined -- | Like 'arbitraryMulSigSHCInput' with no empty signatures. arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput-arbitraryMulSigSHInputFullC net = do- rdm@(PayMulSig _ m) <- arbitraryMSOutputC- sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)- return $ ScriptHashInput (SpendMulSig sigs) rdm+arbitraryMulSigSHInputFullC net =+ arbitraryMSOutputC >>= \case+ rdm@(PayMulSig _ m) -> do+ sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)+ return $ ScriptHashInput (SpendMulSig sigs) rdm+ _ -> undefined
test/Network/Haskoin/BlockSpec.hs view
@@ -5,7 +5,6 @@ import Control.Monad.State.Strict import Data.Aeson as A-import Data.ByteString (ByteString) import Data.Either (fromRight) import Data.Map.Strict (singleton) import Data.Maybe (fromJust)@@ -47,8 +46,7 @@ getBestBlockHeader in nodeHeight bb `shouldBe` 100 it "builds a block locator" $- let net = bchRegTest- loc =+ let loc = withChain net $ do chain net (getGenesisHeader net) 100 bb <- getBestBlockHeader@@ -68,21 +66,19 @@ forAll arbitraryBlockHash $ \h -> fromString (cs $ blockHashToHex h) == h it "show and read block hash" $- property $- forAll arbitraryBlockHash $ \h ->- read (show h) == h+ property $ forAll arbitraryBlockHash $ \h -> read (show h) == h it "json block hash" $ property $ forAll arbitraryBlockHash testID describe "merkle trees" $ do- let net = btc+ let net' = btc it "builds tree of right width at height 1" $ property testTreeWidth it "builds tree of right width at height 0" $ property testBaseWidth it "builds and extracts partial merkle tree" $ property $ forAll (listOf1 ((,) <$> arbitraryTxHash <*> arbitrary))- (buildExtractTree net)+ (buildExtractTree net') it "merkle root test vectors" $- zipWithM_ (curry mapMerkleVectors) merkleVectors [0 ..]+ mapM_ runMerkleVector merkleVectors describe "compact number" $ do it "compact number local vectors" testCompact it "compact number imported vectors" testCompactBitcoinCore@@ -244,9 +240,6 @@ assertBool "vector 9 (decode) (positive)" ((> 0) . fst $ decodeCompact 0xff123456)--mapMerkleVectors :: ((Text, [Text]), Int) -> Assertion-mapMerkleVectors (v, i) = runMerkleVector v runMerkleVector :: (Text, [Text]) -> Assertion runMerkleVector (r, hs) =