Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Feature/dependency pruning #27

Merged
merged 5 commits into from
Oct 10, 2022
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 2 additions & 4 deletions bitcoin.cabal
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.34.4.
-- This file has been generated from package.yaml by hpack version 0.35.0.
--
-- see: https://github.com/sol/hpack

Expand Down Expand Up @@ -93,7 +93,6 @@ library
src
build-depends:
QuickCheck >=2.13.2
, aeson >=1.4.6.0
, array >=0.5.4.0
, base >=4.9 && <5
, base16 >=0.3.0.1
Expand All @@ -108,7 +107,6 @@ library
, hashable >=1.3.0.0
, hspec >=2.7.1
, memory >=0.15.0
, mtl >=2.2.2
, murmur3 >=1.0.3
, network >=3.1.1.1
, safe >=0.3.18
Expand Down Expand Up @@ -136,6 +134,7 @@ test-suite spec
Bitcoin.Keys.MnemonicSpec
Bitcoin.KeysSpec
Bitcoin.NetworkSpec
Bitcoin.Orphans
Bitcoin.ScriptSpec
Bitcoin.Transaction.PartialSpec
Bitcoin.Transaction.TaprootSpec
Expand Down Expand Up @@ -166,7 +165,6 @@ test-suite spec
, lens >=4.18.1
, lens-aeson >=1.1
, memory >=0.15.0
, mtl >=2.2.2
, murmur3 >=1.0.3
, network >=3.1.1.1
, safe >=0.3.18
Expand Down
7 changes: 7 additions & 0 deletions hie.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
cradle:
ProofOfKeags marked this conversation as resolved.
Show resolved Hide resolved
cabal:
- path: "src"
component: "lib:bitcoin"

- path: "test"
component: "bitcoin:test:spec"
3 changes: 1 addition & 2 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,6 @@ extra-source-files:
- README.md
- CHANGELOG.md
dependencies:
- aeson >= 1.4.6.0
- array >= 0.5.4.0
- base >=4.9 && <5
- base16 >= 0.3.0.1
Expand All @@ -34,7 +33,6 @@ dependencies:
- hashable >= 1.3.0.0
- hspec >= 2.7.1
- memory >= 0.15.0
- mtl >= 2.2.2
- murmur3 >= 1.0.3
- network >= 3.1.1.1
- QuickCheck >= 2.13.2
Expand All @@ -61,6 +59,7 @@ tests:
verbatim:
build-tool-depends: hspec-discover:hspec-discover
dependencies:
- aeson >= 1.4.6.0
- base64 ^>= 0.4
- bitcoin
- hspec >= 2.7.1
Expand Down
24 changes: 0 additions & 24 deletions src/Bitcoin/Address.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,9 +22,6 @@ module Bitcoin.Address (
textToAddr,
bech32ToAddr,
base58ToAddr,
addrToJSON,
addrToEncoding,
addrFromJSON,
pubKeyAddr,
pubKeyWitnessAddr,
pubKeyCompatWitnessAddr,
Expand Down Expand Up @@ -57,9 +54,6 @@ import Control.Applicative
import Control.Arrow (second)
import Control.DeepSeq
import Control.Monad
import Data.Aeson as A
import Data.Aeson.Encoding as A
import Data.Aeson.Types
import Data.Binary (Binary (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
Expand Down Expand Up @@ -181,24 +175,6 @@ isWitnessAddress WitnessAddress{} = True
isWitnessAddress _ = False


addrToJSON :: Network -> Address -> Value
addrToJSON net a = toJSON (addrToText net a)


addrToEncoding :: Network -> Address -> Encoding
addrToEncoding net = maybe null_ text . addrToText net


-- | JSON parsing for Bitcoin addresses. Works with 'Base58', and
-- 'Bech32'.
addrFromJSON :: Network -> Value -> Parser Address
addrFromJSON net =
withText "address" $ \t ->
case textToAddr net t of
Nothing -> fail "could not decode address"
Just x -> return x


-- | Convert address to human-readable string. Uses 'Base58', or 'Bech32'
-- depending on network.
addrToText :: Network -> Address -> Maybe Text
Expand Down
75 changes: 0 additions & 75 deletions src/Bitcoin/Block/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,18 +32,6 @@ import Bitcoin.Transaction.Common
import Bitcoin.Util
import Control.DeepSeq
import Control.Monad (forM_, liftM2, mzero, replicateM, (<=<))
import Data.Aeson (
FromJSON (..),
ToJSON (..),
Value (..),
object,
toJSON,
withObject,
withText,
(.:),
(.=),
)
import Data.Aeson.Encoding (pairs, unsafeToEncoding)
import Data.Binary (Binary (..))
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import qualified Data.ByteString as B
Expand Down Expand Up @@ -111,17 +99,6 @@ instance Binary Block where
put = serialize


instance ToJSON Block where
toJSON (Block h t) = object ["header" .= h, "transactions" .= t]
toEncoding (Block h t) = pairs $ "header" .= h <> "transactions" .= t


instance FromJSON Block where
parseJSON =
withObject "Block" $ \o ->
Block <$> o .: "header" <*> o .: "transactions"


-- | Block header hash. To be serialized reversed for display purposes.
newtype BlockHash = BlockHash
{ getBlockHash :: Hash256
Expand Down Expand Up @@ -155,21 +132,6 @@ instance IsString BlockHash where
in fromMaybe e $ hexToBlockHash $ cs s


instance FromJSON BlockHash where
parseJSON =
withText "BlockHash" $
maybe mzero return . hexToBlockHash


instance ToJSON BlockHash where
toJSON = String . blockHashToHex
toEncoding h =
unsafeToEncoding $
char7 '"'
<> hexBuilder (BL.reverse (runPutL (serialize h)))
<> char7 '"'


-- | Block hashes are reversed with respect to the in-memory byte order in a
-- block hash when displayed.
blockHashToHex :: BlockHash -> Text
Expand Down Expand Up @@ -212,43 +174,6 @@ data BlockHeader = BlockHeader
deriving (Eq, Ord, Show, Read, Generic, Hashable, NFData)


-- 80 bytes

instance ToJSON BlockHeader where
toJSON (BlockHeader v p m t b n) =
object
[ "version" .= v
, "prevblock" .= p
, "merkleroot" .= encodeHex (runPutS (serialize m))
, "timestamp" .= t
, "bits" .= b
, "nonce" .= n
]
toEncoding (BlockHeader v p m t b n) =
pairs
( "version" .= v
<> "prevblock" .= p
<> "merkleroot" .= encodeHex (runPutS (serialize 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 . runGetS deserialize <=< decodeHex)


instance Serial BlockHeader where
deserialize = do
v <- getWord32le
Expand Down
29 changes: 10 additions & 19 deletions src/Bitcoin/Block/Headers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ module Bitcoin.Block.Headers (
bip34,
validVersion,
lastNoMinDiff,
computeAsertBits,
computeAssertBits,
nextPowWorkRequired,
calcNextWork,
isValidPOW,
Expand All @@ -68,19 +68,10 @@ import Bitcoin.Util
import Control.Applicative ((<|>))
import Control.DeepSeq
import Control.Monad (guard, mzero, unless, when)
import Control.Monad.Except (
ExceptT (..),
runExceptT,
throwError,
)
import Control.Monad.State.Strict as State (
StateT,
get,
gets,
lift,
modify,
)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE)
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.State.Strict as State (StateT, get, gets, modify)
import Data.Binary (Binary (..))
import Data.Bits (shiftL, shiftR, (.&.))
import qualified Data.ByteString as B
Expand Down Expand Up @@ -323,7 +314,7 @@ connectBlocks _ _ [] = return $ Right []
connectBlocks net t bhs@(bh : _) =
runExceptT $ do
unless (chained bhs) $
throwError "Blocks to connect do not form a chain"
throwE "Blocks to connect do not form a chain"
par <-
maybeToExceptT
"Could not get parent block"
Expand All @@ -347,13 +338,13 @@ connectBlocks net t bhs@(bh : _) =
case skM of
Just sk -> return sk
Nothing ->
throwError $
throwE $
"BUG: Could not get skip for block "
++ show (headerHash $ nodeHeader par)
| otherwise = do
let sn = ls !! fromIntegral (nodeHeight par - sh)
when (nodeHeight sn /= sh) $
throwError "BUG: Node height not right in skip"
throwE "BUG: Node height not right in skip"
return sn
where
sh = skipHeight (nodeHeight par + 1)
Expand Down Expand Up @@ -394,7 +385,7 @@ connectBlock net t bh =
case skM of
Just sk -> return sk
Nothing ->
throwError $
throwE $
"BUG: Could not get skip for block "
++ show (headerHash $ nodeHeader par)
bb <- lift getBestBlockHeader
Expand Down Expand Up @@ -686,13 +677,13 @@ maxTarget :: Integer
maxTarget = fst $ decodeCompact maxBits


computeAsertBits ::
computeAssertBits ::
Integer ->
Word32 ->
Integer ->
Integer ->
Word32
computeAsertBits halflife anchor_bits time_diff height_diff =
computeAssertBits halflife anchor_bits time_diff height_diff =
if e2 >= 0 && e2 < 65536
then
if g4 == 0
Expand Down
23 changes: 0 additions & 23 deletions src/Bitcoin/Keys/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,14 +38,6 @@ import Bitcoin.Util
import Control.DeepSeq
import Control.Monad (guard, mzero, (<=<))
import Crypto.Secp256k1
import Data.Aeson (
FromJSON,
ToJSON (..),
Value (String),
parseJSON,
withText,
)
import Data.Aeson.Encoding (unsafeToEncoding)
import Data.Binary (Binary (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
Expand Down Expand Up @@ -76,21 +68,6 @@ instance IsString PubKeyI where
e = error "Could not decode public key"


instance ToJSON PubKeyI where
toJSON = String . encodeHex . runPutS . serialize
toEncoding s =
unsafeToEncoding $
char7 '"'
<> hexBuilder (runPutL (serialize s))
<> char7 '"'


instance FromJSON PubKeyI where
parseJSON =
withText "PubKeyI" $
maybe mzero return . ((eitherToMaybe . runGetS deserialize) <=< decodeHex)


instance Serial PubKeyI where
deserialize =
s >>= \case
Expand Down
Loading