bitcoin-compact-filters 0.1.0.1 → 0.1.0.2
raw patch · 7 files changed
+251/−242 lines, 7 filesdep −base16-bytestringdep ~basedep ~haskoin-coredep ~memoryPVP ok
version bump matches the API change (PVP)
Dependencies removed: base16-bytestring
Dependency ranges changed: base, haskoin-core, memory
API changes (from Hackage documentation)
Files
- bitcoin-compact-filters.cabal +18/−14
- src/Bitcoin/CompactFilter.hs +140/−133
- test/Main.hs +24/−24
- test/Test/CompactFilter.hs +10/−11
- test/Test/Examples/Bip.hs +27/−26
- test/Test/Examples/Mainnet.hs +6/−7
- test/Test/Util.hs +26/−27
bitcoin-compact-filters.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: bitcoin-compact-filters-version: 0.1.0.1+version: 0.1.0.2 synopsis: BIP 158 compact block filters copyright: 2020 Bitnomial, Inc.@@ -14,15 +14,20 @@ data-files: examples/*.json +tested-with:+ GHC == 8.10.4+ , GHC == 8.10.5+ , GHC == 9.0.1+ common core default-language: Haskell2010 ghc-options: -Wall build-depends:- base >=4.12 && <4.15- , bytestring >=0.10 && <0.12- , cereal ^>=0.5- , haskoin-core >=0.13 && <0.19- , text ^>=1.2+ base >=4.12 && <4.16+ , bytestring >=0.10 && <0.12+ , cereal ^>=0.5+ , haskoin-core >=0.17.1 && <0.21+ , text ^>=1.2 library@@ -33,10 +38,9 @@ Bitcoin.CompactFilter build-depends:- bitstream ^>=0.3.0.1- , base16-bytestring <1.0- , transformers ^>=0.5- , memory ^>=0.15+ bitstream ^>=0.3.0.1+ , transformers ^>=0.5+ , memory >=0.15 && <0.17 test-suite bitcoin-cf-tests@@ -57,8 +61,8 @@ Paths_bitcoin_compact_filters build-depends:- aeson >=1.0 && <1.6+ aeson >=1.0 && <1.6 , bitcoin-compact-filters- , tasty >=1.0 && <1.5- , tasty-hunit >=0.9 && <0.11- , tasty-quickcheck >=0.8.1 && <0.11+ , tasty >=1.0 && <1.5+ , tasty-hunit >=0.9 && <0.11+ , tasty-quickcheck >=0.8.1 && <0.11
src/Bitcoin/CompactFilter.hs view
@@ -1,159 +1,178 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-type-defaults #-} -module Bitcoin.CompactFilter- ( BlockFilter- , blockFilter- , BlockFilterHeader- , blockFilterHeader- , filterHeaderToHex- , filterHeaderFromHex- , genesisHeader- , filterContents- , encodeFilter- , isMember- ) where+module Bitcoin.CompactFilter (+ BlockFilter,+ blockFilter,+ BlockFilterHeader,+ blockFilterHeader,+ filterHeaderToHex,+ filterHeaderFromHex,+ genesisHeader,+ filterContents,+ encodeFilter,+ isMember,+) where -import Control.Monad (replicateM, (>=>))-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State.Strict (StateT, evalStateT)+import Control.Monad (replicateM, (>=>))+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State.Strict (StateT, evalStateT) import qualified Control.Monad.Trans.State.Strict as St-import Data.Bits (shiftL, shiftR, testBit)-import Data.Bitstream (Bitstream, Right)-import qualified Data.Bitstream as BiS-import Data.Bool (bool)-import Data.ByteArray.Hash (SipHash (..), SipKey (..),- sipHash)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import Data.Foldable (foldl')-import Data.List (sort)-import Data.Serialize (Get, Serialize (..), decode,- encode, getWord16le,- getWord32le, getWord64le,- getWord8, putByteString,- putWord16le, putWord32le,- putWord64le, putWord8,- runGet)-import Data.Text (Text)-import Data.Word (Word64, Word8)-import Haskoin.Block (Block, BlockHash,- blockHeader, blockTxns,- headerHash)-import Haskoin.Crypto (Hash256, doubleSHA256)-import Haskoin.Script (Script (..), ScriptOp (..))-import Haskoin.Transaction (scriptOutput, txOut)-import Haskoin.Util (decodeHex, encodeHex)-+import Data.Bits (shiftL, shiftR, testBit)+import Data.Bitstream (Bitstream, Right)+import qualified Data.Bitstream as BiS+import Data.Bool (bool)+import Data.ByteArray.Hash (+ SipHash (..),+ SipKey (..),+ sipHash,+ )+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Foldable (foldl')+import Data.List (sort)+import Data.Serialize (+ Get,+ Serialize (..),+ decode,+ encode,+ getWord16le,+ getWord32le,+ getWord64le,+ getWord8,+ putByteString,+ putWord16le,+ putWord32le,+ putWord64le,+ putWord8,+ runGet,+ )+import Data.Text (Text)+import Data.Word (Word64, Word8)+import Haskoin.Block (+ Block,+ BlockHash,+ blockHeader,+ blockTxns,+ headerHash,+ )+import Haskoin.Crypto (Hash256, doubleSHA256)+import Haskoin.Script (Script (..), ScriptOp (..))+import Haskoin.Transaction (scriptOutput, txOut)+import Haskoin.Util (decodeHex, encodeHex) +-- | SIP hash parameter paramP :: Int paramP = 19 -+-- | SIP hash parameter paramM :: Word64 paramM = 784931 - -- | Hashes of scripts in the block-newtype BlockFilter = BlockFilter { blockFilter :: [Word64] } deriving (Eq, Show)-+newtype BlockFilter = BlockFilter+ { -- | Get the list of hashes in increasing order+ blockFilter :: [Word64]+ }+ deriving (Eq, Show) +-- | Number of elements in the filter blockFilterSize :: BlockFilter -> CompactSize blockFilterSize = CompactSize . length . blockFilter --newtype BlockFilterHeader = BlockFilterHeader { getBFHeader :: Hash256 }+newtype BlockFilterHeader = BlockFilterHeader {getBFHeader :: Hash256} deriving (Eq, Show, Ord, Serialize) - filterHeaderToHex :: BlockFilterHeader -> Text filterHeaderToHex = encodeHex . BS.reverse . encode . getBFHeader - filterHeaderFromHex :: Text -> Either String BlockFilterHeader filterHeaderFromHex = maybe (Left "Invalid hex") Right . decodeHex >=> decode . BS.reverse - genesisHeader :: BlockFilterHeader Right genesisHeader = BlockFilterHeader <$> decode (BS.replicate 32 0x0) --blockFilterHeader :: BlockFilterHeader -> BlockFilter -> BlockFilterHeader-blockFilterHeader prev bf- = BlockFilterHeader . doubleSHA256- $ (encode . doubleSHA256) (encode bf) <> encode (getBFHeader prev)-+-- | Calculate the header for the block filter+blockFilterHeader ::+ -- | previous header+ BlockFilterHeader ->+ -- | current filter+ BlockFilter ->+ BlockFilterHeader+blockFilterHeader prev bf =+ BlockFilterHeader . doubleSHA256 $+ (encode . doubleSHA256) (encode bf) <> encode (getBFHeader prev) instance Serialize BlockFilter where put bf = put (blockFilterSize bf) >> putByteString (constructGCS paramP $ blockFilter bf) get = get >>= fmap BlockFilter . getGolombRiceSet paramP . unCompactSize ---- | Scripts in the block which belong in the BIP158 block filter-filterContents- :: [ByteString]- -- ^ previous output scripts spent in this block- -> Block- -> [ByteString]+-- | Calculate the list of scripts which belong in the BIP158 block filter+filterContents ::+ -- | previous output scripts spent in this block+ [ByteString] ->+ Block ->+ [ByteString] filterContents prev b = filter scriptFilter prev <> these- where- these = filter scriptFilter . fmap scriptOutput $ blockTxns b >>= txOut+ where+ these = filter scriptFilter . fmap scriptOutput $ blockTxns b >>= txOut scriptFilter scr = not (BS.null scr) && contentFilter scr contentFilter bs = case decode bs of Right (Script (OP_RETURN : _)) -> False- _ -> True-+ _ -> True -- | Construct a BIP158 filter from a block-encodeFilter :: [ByteString] -> Block -> BlockFilter+encodeFilter ::+ -- | output scripts spent in this block+ [ByteString] ->+ Block ->+ BlockFilter encodeFilter os b = BlockFilter s- where- h = headerHash $ blockHeader b+ where+ h = headerHash $ blockHeader b bs = toSet $ filterContents os b- s = hashedSetConstruct (sipKey h) paramM (length bs) bs-+ s = hashedSetConstruct (sipKey h) paramM (length bs) bs --- | Test membership-isMember :: BlockHash -> [ByteString] -> BlockFilter -> Bool+-- | Test membership. The test succeeds if /any/ of the scripts matches the block filter.+isMember ::+ BlockHash ->+ -- | Scripts we want to match against the filter+ [ByteString] ->+ BlockFilter ->+ Bool isMember h bs (BlockFilter bf) = orderedScan hs bf- where- k = sipKey h+ where+ k = sipKey h hs = hashedSetConstruct k paramM (length bf) bs - orderedScan :: [Word64] -> [Word64] -> Bool orderedScan xs@(x : xs') hs@(h : hs')- | x > h = orderedScan xs hs'- | x < h = orderedScan xs' hs+ | x > h = orderedScan xs hs'+ | x < h = orderedScan xs' hs | otherwise = True orderedScan _ _ = False - type GetBits = StateT [Bool] Get - getGolombRiceSet :: Int -> Int -> Get [Word64] getGolombRiceSet p n = fmap unDiffs . evalBitstream $ replicateM n getEncoded- where+ where getEncoded = do q <- unaryPart r <- fromBits <$> getBits p- return $ q * 2^p + r-+ return $ q * 2 ^ p + r unaryPart :: GetBits Word64 unaryPart = go 0- where- go q = getBit >>= bool (return q) (go $ q + 1)+ where+ go q = getBit >>= bool (return q) (go $ q + 1) getBit = head <$> getBits 1 - evalBitstream :: GetBits a -> Get a evalBitstream = (`evalStateT` mempty) - getBits :: Int -> GetBits [Bool] getBits n = do bs <- St.get@@ -163,107 +182,95 @@ combine m t = bs <> mconcat m <> t lastByte- | r > 0 = getBs >>= takeSome r+ | r > 0 = getBs >>= takeSome r | otherwise = mempty <$ St.put mempty - getBs = byteBits <$> lift getWord8+ getBs = byteBits <$> lift getWord8 takeSome m xs = take m xs <$ St.put (drop m xs) if n < l then takeSome n bs else combine <$> replicateM q getBs <*> lastByte - sipKey :: BlockHash -> SipKey sipKey h = SipKey k1 k2- where+ where Right (k1, k2) = runGet word64Pair $ encode h- word64Pair = (,) <$> getWord64le <*> getWord64le-+ word64Pair = (,) <$> getWord64le <*> getWord64le hashToRange :: Word64 -> SipKey -> ByteString -> Word64 hashToRange f k bs = v- where+ where SipHash h = sipHash k bs- v = remap (fromIntegral f) (fromIntegral h)+ v = remap (fromIntegral f) (fromIntegral h) remap :: Integer -> Integer -> Word64 remap x y = fromIntegral $ (x * y) `shiftR` 64 - hashedSetConstruct :: SipKey -> Word64 -> Int -> [ByteString] -> [Word64] hashedSetConstruct k m n bs = toSet $ hashToRange f k <$> bs- where+ where f = fromIntegral n * m - toSet :: Ord a => [a] -> [a] toSet = dedup . sort- where+ where dedup = \case (x0 : xs@(x1 : _))- | x0 == x1 -> dedup xs+ | x0 == x1 -> dedup xs | otherwise -> x0 : dedup xs xs -> xs --constructGCS- :: Int- -- ^ modulus- -> [Word64]- -- ^ sorted list of input values- -> ByteString-constructGCS p- = BiS.toByteString- . foldMap (golombRiceEncode p)- . diffs-+constructGCS ::+ -- | modulus+ Int ->+ -- | sorted list of input values+ [Word64] ->+ ByteString+constructGCS p =+ BiS.toByteString+ . foldMap (golombRiceEncode p)+ . diffs diffs :: Num a => [a] -> [a] diffs xs = zipWith (-) xs (0 : xs) - unDiffs :: Num a => [a] -> [a] unDiffs (x : xs) = scanl (+) x xs-unDiffs [] = []-+unDiffs [] = [] golombRiceEncode :: Int -> Word64 -> Bitstream Right golombRiceEncode p v = x <> BiS.singleton False <> y- where+ where q = fromIntegral $ v `shiftR` p x = BiS.replicate q True y = BiS.fromNBits p v - fromBits :: Num a => [Bool] -> a fromBits = foldl' onBit 0- where+ where onBit n b = 2 * n + bool 0 1 b - byteBits :: Word8 -> [Bool] byteBits b = testBit b <$> reverse [0 .. 7] --newtype CompactSize = CompactSize { unCompactSize :: Int } deriving (Eq, Ord, Enum, Num, Real, Integral)-+newtype CompactSize = CompactSize {unCompactSize :: Int} deriving (Eq, Ord, Enum, Num, Real, Integral) instance Serialize CompactSize where get = CompactSize <$> (getWord8 >>= getCS)- where+ where getCS s- | s < 253 = return $ fromIntegral s- | s == 253 = fromIntegral <$> getWord16le- | s == 254 = fromIntegral <$> getWord32le+ | s < 253 = return $ fromIntegral s+ | s == 253 = fromIntegral <$> getWord16le+ | s == 254 = fromIntegral <$> getWord32le | otherwise = fromIntegral <$> getWord64le put (CompactSize n)- | n < 0 = error $ "Invalid CompactSize: " <> show n- | n < 253 = putWord8 (fromIntegral n)+ | n < 0 = error $ "Invalid CompactSize: " <> show n+ | n < 253 = putWord8 (fromIntegral n) | n < bound16 = putWord8 253 >> putWord16le (fromIntegral n) | n < bound32 = putWord8 254 >> putWord32le (fromIntegral n)- | otherwise = putWord8 255 >> putWord64le (fromIntegral n)- where+ | otherwise = putWord8 255 >> putWord64le (fromIntegral n)+ where bound16 = 1 `shiftL` 16 bound32 = 1 `shiftL` 32
test/Main.hs view
@@ -1,56 +1,56 @@ module Main where -import Data.Serialize (decode, encode)-import Haskoin.Block (blockHeader, headerHash)-import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))-import Test.Tasty.QuickCheck (elements, forAll, testProperty, (===))+import Data.Serialize (decode, encode)+import Haskoin.Block (blockHeader, headerHash)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck (elements, forAll, testProperty, (===)) -import Bitcoin.CompactFilter (blockFilterHeader, encodeFilter,- filterContents, isMember)-import Test.CompactFilter (genBlockFilter)-import qualified Test.Examples.Bip as BIP+import Bitcoin.CompactFilter (+ blockFilterHeader,+ encodeFilter,+ filterContents,+ isMember,+ )+import Test.CompactFilter (genBlockFilter)+import qualified Test.Examples.Bip as BIP import qualified Test.Examples.Mainnet as Mainnet-import Test.Util (Example (..))-+import Test.Util (Example (..)) main :: IO () main = do- bipExamples <- BIP.examples+ bipExamples <- BIP.examples mainnetExamples <- Mainnet.examples defaultMain . testGroup "bip158 unit tests" $ [ testGroup "Serialization" [testRoundtrip]- , testGroup "Filter"+ , testGroup+ "Filter" [ testGroup "BIP 158" $ testFilter <$> bipExamples , testGroup "Mainnet" $ testFilter <$> mainnetExamples ] ] - testRoundtrip :: TestTree testRoundtrip = testProperty "serialization round trip" . forAll genBlockFilter $ \bf -> decode (encode bf) === Right bf - testFilter :: Example -> TestTree-testFilter v = testGroup (testLabel v) $ [ construction ] <> [ membership | not (null ss) ]-- where-+testFilter v = testGroup (testLabel v) $ [construction] <> [membership | not (null ss)]+ where construction = testCase "Construction" $ do ourFilter @?= exampleFilter v ourHeader @?= exampleHeader v - membership = testProperty "Filter membership" $ forAll (elements ss) $ \s ->- isMember bh [s] ourFilter+ membership = testProperty "Filter membership" $+ forAll (elements ss) $ \s ->+ isMember bh [s] ourFilter ourFilter = encodeFilter (examplePrevOuts v) block ourHeader = blockFilterHeader (examplePrevHeader v) ourFilter- bh = headerHash $ blockHeader block- ss = filterContents (examplePrevOuts v) block+ bh = headerHash $ blockHeader block+ ss = filterContents (examplePrevOuts v) block block = exampleBlock v- testLabel :: Example -> String testLabel e = "Block " <> show (exampleHeight e)
test/Test/CompactFilter.hs view
@@ -1,19 +1,18 @@-module Test.CompactFilter- ( genBlockFilter- ) where--import Control.Monad (replicateM)-import Haskoin.Constants (btc)-import Haskoin.Util.Arbitrary.Block (arbitraryBlock)-import Haskoin.Util.Arbitrary.Util (arbitraryBS1)-import Test.Tasty.QuickCheck (Gen, choose)+module Test.CompactFilter (+ genBlockFilter,+) where -import Bitcoin.CompactFilter (BlockFilter, encodeFilter)+import Control.Monad (replicateM)+import Haskoin.Constants (btc)+import Haskoin.Util.Arbitrary.Block (arbitraryBlock)+import Haskoin.Util.Arbitrary.Util (arbitraryBS1)+import Test.Tasty.QuickCheck (Gen, choose) +import Bitcoin.CompactFilter (BlockFilter, encodeFilter) genBlockFilter :: Gen BlockFilter genBlockFilter = encodeFilter <$> scripts <*> arbitraryBlock btc- where+ where scripts = do n <- choose (1, 100) replicateM n arbitraryBS1
test/Test/Examples/Bip.hs view
@@ -1,33 +1,34 @@ {-# OPTIONS_GHC -Wno-type-defaults #-} -module Test.Examples.Bip- ( examples- ) where--import Data.Aeson (eitherDecodeFileStrict)-import Data.Text (Text)-import Haskoin.Block (BlockHeight)+module Test.Examples.Bip (+ examples,+) where -import Bitcoin.CompactFilter (filterHeaderFromHex)-import Paths_bitcoin_compact_filters (getDataFileName)-import Test.Util (Example (..), decodeFromHex,- parseHex)+import Data.Aeson (eitherDecodeFileStrict)+import Data.Text (Text)+import Haskoin.Block (BlockHeight) +import Bitcoin.CompactFilter (filterHeaderFromHex)+import Paths_bitcoin_compact_filters (getDataFileName)+import Test.Util (+ Example (..),+ decodeFromHex,+ parseHex,+ ) examples :: IO [Example]-examples- = getDataFileName "examples/testnet-19.json"- >>= eitherDecodeFileStrict- >>= either error return . (>>= traverse interpretRawVector)-+examples =+ getDataFileName "examples/testnet-19.json"+ >>= eitherDecodeFileStrict+ >>= either error return . (>>= traverse interpretRawVector) -interpretRawVector- :: (BlockHeight, Text, Text, [Text], Text, Text, Text, Text)- -> Either String Example-interpretRawVector (n, h, b, ss, ph, f, fh, _)- = Example n <$> decodeFromHex h- <*> decodeFromHex b- <*> traverse parseHex ss- <*> decodeFromHex f- <*> filterHeaderFromHex ph- <*> filterHeaderFromHex fh+interpretRawVector ::+ (BlockHeight, Text, Text, [Text], Text, Text, Text, Text) ->+ Either String Example+interpretRawVector (n, h, b, ss, ph, f, fh, _) =+ Example n <$> decodeFromHex h+ <*> decodeFromHex b+ <*> traverse parseHex ss+ <*> decodeFromHex f+ <*> filterHeaderFromHex ph+ <*> filterHeaderFromHex fh
test/Test/Examples/Mainnet.hs view
@@ -1,12 +1,11 @@-module Test.Examples.Mainnet- ( examples- ) where--import Data.Aeson (eitherDecodeFileStrict)+module Test.Examples.Mainnet (+ examples,+) where -import Paths_bitcoin_compact_filters (getDataFileName)-import Test.Util (Example)+import Data.Aeson (eitherDecodeFileStrict) +import Paths_bitcoin_compact_filters (getDataFileName)+import Test.Util (Example) examples :: IO [Example] examples = getDataFileName "examples/examples.json" >>= eitherDecodeFileStrict >>= either error return
test/Test/Util.hs view
@@ -1,42 +1,42 @@ {-# LANGUAGE OverloadedStrings #-} -module Test.Util- ( Example (..)- , decodeFromHex- , parseHex- ) where--import Control.Monad ((>=>))-import Data.Aeson (FromJSON (..), withObject, (.:))-import Data.Aeson.Types (Parser)-import Data.ByteString (ByteString)-import Data.Serialize (Serialize, decode)-import Data.Text (Text)-import Haskoin.Block (Block, BlockHash, BlockHeight)-import qualified Haskoin.Util as U+module Test.Util (+ Example (..),+ decodeFromHex,+ parseHex,+) where -import Bitcoin.CompactFilter (BlockFilter, BlockFilterHeader,- filterHeaderFromHex)+import Control.Monad ((>=>))+import Data.Aeson (FromJSON (..), withObject, (.:))+import Data.Aeson.Types (Parser)+import Data.ByteString (ByteString)+import Data.Serialize (Serialize, decode)+import Data.Text (Text)+import Haskoin.Block (Block, BlockHash, BlockHeight)+import qualified Haskoin.Util as U +import Bitcoin.CompactFilter (+ BlockFilter,+ BlockFilterHeader,+ filterHeaderFromHex,+ ) decodeFromHex :: Serialize a => Text -> Either String a decodeFromHex = parseHex >=> decode - parseHex :: Text -> Either String ByteString parseHex = maybe (Left "Bad hex") Right . U.decodeHex - data Example = Example- { exampleHeight :: BlockHeight- , exampleBlockHash :: BlockHash- , exampleBlock :: Block- , examplePrevOuts :: [ByteString]- , exampleFilter :: BlockFilter+ { exampleHeight :: BlockHeight+ , exampleBlockHash :: BlockHash+ , exampleBlock :: Block+ , examplePrevOuts :: [ByteString]+ , exampleFilter :: BlockFilter , examplePrevHeader :: BlockFilterHeader- , exampleHeader :: BlockFilterHeader- } deriving (Eq, Show)-+ , exampleHeader :: BlockFilterHeader+ }+ deriving (Eq, Show) instance FromJSON Example where parseJSON = withObject "Example" $ \obj ->@@ -48,7 +48,6 @@ <*> (fromHex =<< obj .: "filter") <*> (either fail return . filterHeaderFromHex =<< obj .: "prev_filter_header") <*> (either fail return . filterHeaderFromHex =<< obj .: "filter_header")- fromHex :: Serialize a => Text -> Parser a fromHex = either fail return . decodeFromHex