{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

{- |
Module      : Haskoin.Network.Bloom
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX

Bloom filters are used to reduce data transfer when synchronizing thin cients.
When bloom filters are used a client will obtain filtered blocks that only
contain transactions that pass the bloom filter. Transactions announced via inv
messages also pass the filter.
-}
module Haskoin.Network.Bloom (
    -- * Bloom Filters
    BloomFlags (..),
    BloomFilter (..),
    FilterLoad (..),
    FilterAdd (..),
    bloomCreate,
    bloomInsert,
    bloomContains,
    isBloomValid,
    isBloomEmpty,
    isBloomFull,
    acceptsFilters,
    bloomRelevantUpdate,
) where

import Control.DeepSeq
import Control.Monad (forM_, replicateM)
import Data.Binary (Binary (..))
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
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 (..))
import Data.Word
import GHC.Generics (Generic)
import Haskoin.Network.Common
import Haskoin.Script.Standard
import Haskoin.Transaction.Common

-- | 20,000 items with fp rate < 0.1% or 10,000 items and <0.0001%
maxBloomSize :: Int
maxBloomSize :: Int
maxBloomSize = Int
36000

maxHashFuncs :: Word32
maxHashFuncs :: Word32
maxHashFuncs = Word32
50

ln2Squared :: Double
ln2Squared :: Double
ln2Squared = Double
0.4804530139182014246671025263266649717305529515945455

ln2 :: Double
ln2 :: Double
ln2 = Double
0.6931471805599453094172321214581765680755001343602552

bitMask :: [Word8]
bitMask :: [Word8]
bitMask = [Word8
0x01, Word8
0x02, Word8
0x04, Word8
0x08, Word8
0x10, Word8
0x20, Word8
0x40, Word8
0x80]

{- | The bloom flags are used to tell the remote peer how to auto-update
 the provided bloom filter.
-}
data BloomFlags
    = -- | never update
      BloomUpdateNone
    | -- | auto-update on all outputs
      BloomUpdateAll
    | -- | auto-update on pay-to-pubkey or pay-to-multisig (default)
      BloomUpdateP2PubKeyOnly
    deriving (BloomFlags -> BloomFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BloomFlags -> BloomFlags -> Bool
$c/= :: BloomFlags -> BloomFlags -> Bool
== :: BloomFlags -> BloomFlags -> Bool
$c== :: BloomFlags -> BloomFlags -> Bool
Eq, Int -> BloomFlags -> ShowS
[BloomFlags] -> ShowS
BloomFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BloomFlags] -> ShowS
$cshowList :: [BloomFlags] -> ShowS
show :: BloomFlags -> String
$cshow :: BloomFlags -> String
showsPrec :: Int -> BloomFlags -> ShowS
$cshowsPrec :: Int -> BloomFlags -> ShowS
Show, ReadPrec [BloomFlags]
ReadPrec BloomFlags
Int -> ReadS BloomFlags
ReadS [BloomFlags]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BloomFlags]
$creadListPrec :: ReadPrec [BloomFlags]
readPrec :: ReadPrec BloomFlags
$creadPrec :: ReadPrec BloomFlags
readList :: ReadS [BloomFlags]
$creadList :: ReadS [BloomFlags]
readsPrec :: Int -> ReadS BloomFlags
$creadsPrec :: Int -> ReadS BloomFlags
Read, forall x. Rep BloomFlags x -> BloomFlags
forall x. BloomFlags -> Rep BloomFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BloomFlags x -> BloomFlags
$cfrom :: forall x. BloomFlags -> Rep BloomFlags x
Generic, BloomFlags -> ()
forall a. (a -> ()) -> NFData a
rnf :: BloomFlags -> ()
$crnf :: BloomFlags -> ()
NFData)

instance Serial BloomFlags where
    deserialize :: forall (m :: * -> *). MonadGet m => m BloomFlags
deserialize = forall {a} {m :: * -> *}.
(Eq a, Num a, MonadFail m) =>
a -> m BloomFlags
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadGet m => m Word8
getWord8
      where
        go :: a -> m BloomFlags
go a
0 = forall (m :: * -> *) a. Monad m => a -> m a
return BloomFlags
BloomUpdateNone
        go a
1 = forall (m :: * -> *) a. Monad m => a -> m a
return BloomFlags
BloomUpdateAll
        go a
2 = forall (m :: * -> *) a. Monad m => a -> m a
return BloomFlags
BloomUpdateP2PubKeyOnly
        go a
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"BloomFlags get: Invalid bloom flag"

    serialize :: forall (m :: * -> *). MonadPut m => BloomFlags -> m ()
serialize BloomFlags
f = forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 forall a b. (a -> b) -> a -> b
$ case BloomFlags
f of
        BloomFlags
BloomUpdateNone -> Word8
0
        BloomFlags
BloomUpdateAll -> Word8
1
        BloomFlags
BloomUpdateP2PubKeyOnly -> Word8
2

instance Binary BloomFlags where
    get :: Get BloomFlags
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    put :: BloomFlags -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

instance Serialize BloomFlags where
    get :: Get BloomFlags
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    put :: Putter BloomFlags
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

{- | A bloom filter is a probabilistic data structure that SPV clients send to
 other peers to filter the set of transactions received from them. Bloom
 filters can have false positives but not false negatives. Some transactions
 that pass the filter may not be relevant to the receiving peer. By
 controlling the false positive rate, SPV nodes can trade off bandwidth
 versus privacy.
-}
data BloomFilter = BloomFilter
    { -- | bloom filter data
      BloomFilter -> Seq Word8
bloomData :: !(S.Seq Word8)
    , -- | number of hash functions for this filter
      BloomFilter -> Word32
bloomHashFuncs :: !Word32
    , -- | hash function random nonce
      BloomFilter -> Word32
bloomTweak :: !Word32
    , -- | bloom filter auto-update flags
      BloomFilter -> BloomFlags
bloomFlags :: !BloomFlags
    }
    deriving (BloomFilter -> BloomFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BloomFilter -> BloomFilter -> Bool
$c/= :: BloomFilter -> BloomFilter -> Bool
== :: BloomFilter -> BloomFilter -> Bool
$c== :: BloomFilter -> BloomFilter -> Bool
Eq, Int -> BloomFilter -> ShowS
[BloomFilter] -> ShowS
BloomFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BloomFilter] -> ShowS
$cshowList :: [BloomFilter] -> ShowS
show :: BloomFilter -> String
$cshow :: BloomFilter -> String
showsPrec :: Int -> BloomFilter -> ShowS
$cshowsPrec :: Int -> BloomFilter -> ShowS
Show, ReadPrec [BloomFilter]
ReadPrec BloomFilter
Int -> ReadS BloomFilter
ReadS [BloomFilter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BloomFilter]
$creadListPrec :: ReadPrec [BloomFilter]
readPrec :: ReadPrec BloomFilter
$creadPrec :: ReadPrec BloomFilter
readList :: ReadS [BloomFilter]
$creadList :: ReadS [BloomFilter]
readsPrec :: Int -> ReadS BloomFilter
$creadsPrec :: Int -> ReadS BloomFilter
Read, forall x. Rep BloomFilter x -> BloomFilter
forall x. BloomFilter -> Rep BloomFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BloomFilter x -> BloomFilter
$cfrom :: forall x. BloomFilter -> Rep BloomFilter x
Generic, BloomFilter -> ()
forall a. (a -> ()) -> NFData a
rnf :: BloomFilter -> ()
$crnf :: BloomFilter -> ()
NFData)

instance Serial BloomFilter where
    deserialize :: forall (m :: * -> *). MonadGet m => m BloomFilter
deserialize =
        Seq Word8 -> Word32 -> Word32 -> BloomFlags -> BloomFilter
BloomFilter
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [a] -> Seq a
S.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {m :: * -> *}. MonadGet m => VarInt -> m [Word8]
readDat forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGet m => m Word32
getWord32le
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGet m => m Word32
getWord32le
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
      where
        readDat :: VarInt -> m [Word8]
readDat (VarInt Word64
len) = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len) forall (m :: * -> *). MonadGet m => m Word8
getWord8

    serialize :: forall (m :: * -> *). MonadPut m => BloomFilter -> m ()
serialize (BloomFilter Seq Word8
dat Word32
hashFuncs Word32
tweak BloomFlags
flags) = do
        forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int
S.length Seq Word8
dat
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Word8
dat) forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8
        forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
hashFuncs
        forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
tweak
        forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BloomFlags
flags

instance Binary BloomFilter where
    put :: BloomFilter -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get BloomFilter
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serialize BloomFilter where
    put :: Putter BloomFilter
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get BloomFilter
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Set a new bloom filter on the peer connection.
newtype FilterLoad = FilterLoad {FilterLoad -> BloomFilter
filterLoadBloomFilter :: BloomFilter}
    deriving (FilterLoad -> FilterLoad -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterLoad -> FilterLoad -> Bool
$c/= :: FilterLoad -> FilterLoad -> Bool
== :: FilterLoad -> FilterLoad -> Bool
$c== :: FilterLoad -> FilterLoad -> Bool
Eq, Int -> FilterLoad -> ShowS
[FilterLoad] -> ShowS
FilterLoad -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterLoad] -> ShowS
$cshowList :: [FilterLoad] -> ShowS
show :: FilterLoad -> String
$cshow :: FilterLoad -> String
showsPrec :: Int -> FilterLoad -> ShowS
$cshowsPrec :: Int -> FilterLoad -> ShowS
Show, ReadPrec [FilterLoad]
ReadPrec FilterLoad
Int -> ReadS FilterLoad
ReadS [FilterLoad]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FilterLoad]
$creadListPrec :: ReadPrec [FilterLoad]
readPrec :: ReadPrec FilterLoad
$creadPrec :: ReadPrec FilterLoad
readList :: ReadS [FilterLoad]
$creadList :: ReadS [FilterLoad]
readsPrec :: Int -> ReadS FilterLoad
$creadsPrec :: Int -> ReadS FilterLoad
Read, forall x. Rep FilterLoad x -> FilterLoad
forall x. FilterLoad -> Rep FilterLoad x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterLoad x -> FilterLoad
$cfrom :: forall x. FilterLoad -> Rep FilterLoad x
Generic, FilterLoad -> ()
forall a. (a -> ()) -> NFData a
rnf :: FilterLoad -> ()
$crnf :: FilterLoad -> ()
NFData)

instance Serial FilterLoad where
    deserialize :: forall (m :: * -> *). MonadGet m => m FilterLoad
deserialize = BloomFilter -> FilterLoad
FilterLoad forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    serialize :: forall (m :: * -> *). MonadPut m => FilterLoad -> m ()
serialize (FilterLoad BloomFilter
f) = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BloomFilter
f

instance Binary FilterLoad where
    put :: FilterLoad -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get FilterLoad
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serialize FilterLoad where
    put :: Putter FilterLoad
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get FilterLoad
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

{- | Add the given data element to the connections current filter without
 requiring a completely new one to be set.
-}
newtype FilterAdd = FilterAdd {FilterAdd -> ByteString
getFilterData :: ByteString}
    deriving (FilterAdd -> FilterAdd -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterAdd -> FilterAdd -> Bool
$c/= :: FilterAdd -> FilterAdd -> Bool
== :: FilterAdd -> FilterAdd -> Bool
$c== :: FilterAdd -> FilterAdd -> Bool
Eq, Int -> FilterAdd -> ShowS
[FilterAdd] -> ShowS
FilterAdd -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterAdd] -> ShowS
$cshowList :: [FilterAdd] -> ShowS
show :: FilterAdd -> String
$cshow :: FilterAdd -> String
showsPrec :: Int -> FilterAdd -> ShowS
$cshowsPrec :: Int -> FilterAdd -> ShowS
Show, ReadPrec [FilterAdd]
ReadPrec FilterAdd
Int -> ReadS FilterAdd
ReadS [FilterAdd]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FilterAdd]
$creadListPrec :: ReadPrec [FilterAdd]
readPrec :: ReadPrec FilterAdd
$creadPrec :: ReadPrec FilterAdd
readList :: ReadS [FilterAdd]
$creadList :: ReadS [FilterAdd]
readsPrec :: Int -> ReadS FilterAdd
$creadsPrec :: Int -> ReadS FilterAdd
Read, forall x. Rep FilterAdd x -> FilterAdd
forall x. FilterAdd -> Rep FilterAdd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterAdd x -> FilterAdd
$cfrom :: forall x. FilterAdd -> Rep FilterAdd x
Generic, FilterAdd -> ()
forall a. (a -> ()) -> NFData a
rnf :: FilterAdd -> ()
$crnf :: FilterAdd -> ()
NFData)

instance Serial FilterAdd where
    deserialize :: forall (m :: * -> *). MonadGet m => m FilterAdd
deserialize = do
        (VarInt Word64
len) <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        ByteString
dat <- forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> FilterAdd
FilterAdd ByteString
dat

    serialize :: forall (m :: * -> *). MonadPut m => FilterAdd -> m ()
serialize (FilterAdd ByteString
bs) = do
        forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
        forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
bs

instance Binary FilterAdd where
    put :: FilterAdd -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get FilterAdd
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serialize FilterAdd where
    put :: Putter FilterAdd
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get FilterAdd
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

{- | Build a bloom filter that will provide the given false positive rate when
 the given number of elements have been inserted.
-}
bloomCreate ::
    -- | number of elements
    Int ->
    -- | false positive rate
    Double ->
    -- | random nonce (tweak) for the hash function
    Word32 ->
    -- | bloom filter flags
    BloomFlags ->
    -- | bloom filter
    BloomFilter
bloomCreate :: Int -> Double -> Word32 -> BloomFlags -> BloomFilter
bloomCreate Int
numElem Double
fpRate =
    Seq Word8 -> Word32 -> Word32 -> BloomFlags -> BloomFilter
BloomFilter (forall a. Int -> a -> Seq a
S.replicate Int
bloomSize Word8
0) Word32
numHashF
  where
    -- Bloom filter size in bytes
    bloomSize :: Int
bloomSize = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Double
a Double
b forall a. Fractional a => a -> a -> a
/ Double
8
    -- Suggested size in bits
    a :: Double
a = -Double
1 forall a. Fractional a => a -> a -> a
/ Double
ln2Squared forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numElem forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log Double
fpRate
    -- Maximum size in bits
    b :: Double
b = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
maxBloomSize forall a. Num a => a -> a -> a
* Int
8
    numHashF :: Word32
numHashF = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Double
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
maxHashFuncs)
    -- Suggested number of hash functions
    c :: Double
c = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bloomSize forall a. Num a => a -> a -> a
* Double
8 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numElem forall a. Num a => a -> a -> a
* Double
ln2

bloomHash :: BloomFilter -> Word32 -> ByteString -> Word32
bloomHash :: BloomFilter -> Word32 -> ByteString -> Word32
bloomHash BloomFilter
bfilter Word32
hashNum ByteString
bs =
    Word32 -> ByteString -> Word32
murmur3 Word32
seed ByteString
bs forall a. Integral a => a -> a -> a
`mod` (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Seq a -> Int
S.length (BloomFilter -> Seq Word8
bloomData BloomFilter
bfilter)) forall a. Num a => a -> a -> a
* Word32
8)
  where
    seed :: Word32
seed = Word32
hashNum forall a. Num a => a -> a -> a
* Word32
0xfba4c795 forall a. Num a => a -> a -> a
+ BloomFilter -> Word32
bloomTweak BloomFilter
bfilter

{- | Insert arbitrary data into a bloom filter. Returns the new bloom filter
 containing the new data.
-}
bloomInsert ::
    -- | Original bloom filter
    BloomFilter ->
    -- | New data to insert
    ByteString ->
    -- | Bloom filter containing the new data
    BloomFilter
bloomInsert :: BloomFilter -> ByteString -> BloomFilter
bloomInsert BloomFilter
bfilter ByteString
bs
    | BloomFilter -> Bool
isBloomFull BloomFilter
bfilter = BloomFilter
bfilter
    | Bool
otherwise = BloomFilter
bfilter{bloomData :: Seq Word8
bloomData = Seq Word8
newData}
  where
    idxs :: [Word32]
idxs = forall a b. (a -> b) -> [a] -> [b]
map (\Word32
i -> BloomFilter -> Word32 -> ByteString -> Word32
bloomHash BloomFilter
bfilter Word32
i ByteString
bs) [Word32
0 .. BloomFilter -> Word32
bloomHashFuncs BloomFilter
bfilter forall a. Num a => a -> a -> a
- Word32
1]
    upd :: Seq Word8 -> a -> Seq Word8
upd Seq Word8
s a
i =
        forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust
            (forall a. Bits a => a -> a -> a
.|. [Word8]
bitMask forall a. [a] -> Int -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
7 forall a. Bits a => a -> a -> a
.&. a
i))
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ a
i forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
            Seq Word8
s
    newData :: Seq Word8
newData = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a}. (Integral a, Bits a) => Seq Word8 -> a -> Seq Word8
upd (BloomFilter -> Seq Word8
bloomData BloomFilter
bfilter) [Word32]
idxs

{- | Tests if some arbitrary data matches the filter. This can be either because
 the data was inserted into the filter or because it is a false positive.
-}
bloomContains ::
    -- | Bloom filter
    BloomFilter ->
    -- | Data that will be checked against the given bloom filter
    ByteString ->
    -- | Returns True if the data matches the filter
    Bool
bloomContains :: BloomFilter -> ByteString -> Bool
bloomContains BloomFilter
bfilter ByteString
bs
    | BloomFilter -> Bool
isBloomFull BloomFilter
bfilter = Bool
True
    | BloomFilter -> Bool
isBloomEmpty BloomFilter
bfilter = Bool
False
    | Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {a}. (Integral a, Bits a) => a -> Bool
isSet [Word32]
idxs
  where
    s :: Seq Word8
s = BloomFilter -> Seq Word8
bloomData BloomFilter
bfilter
    idxs :: [Word32]
idxs = forall a b. (a -> b) -> [a] -> [b]
map (\Word32
i -> BloomFilter -> Word32 -> ByteString -> Word32
bloomHash BloomFilter
bfilter Word32
i ByteString
bs) [Word32
0 .. BloomFilter -> Word32
bloomHashFuncs BloomFilter
bfilter forall a. Num a => a -> a -> a
- Word32
1]
    isSet :: a -> Bool
isSet a
i =
        forall a. Seq a -> Int -> a
S.index Seq Word8
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ a
i forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
            forall a. Bits a => a -> a -> a
.&. ([Word8]
bitMask forall a. [a] -> Int -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
7 forall a. Bits a => a -> a -> a
.&. a
i)) forall a. Eq a => a -> a -> Bool
/= Word8
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
 a future tx that spends the output won't be missed).
-}
bloomRelevantUpdate ::
    -- | Bloom filter
    BloomFilter ->
    -- | Tx that may (or may not) have relevant outputs
    Tx ->
    -- | Returns an updated bloom filter adding relevant output
    Maybe BloomFilter
bloomRelevantUpdate :: BloomFilter -> Tx -> Maybe BloomFilter
bloomRelevantUpdate BloomFilter
bfilter Tx
tx
    | BloomFilter -> Bool
isBloomFull BloomFilter
bfilter Bool -> Bool -> Bool
|| BloomFilter -> Bool
isBloomEmpty BloomFilter
bfilter = forall a. Maybe a
Nothing
    | BloomFilter -> BloomFlags
bloomFlags BloomFilter
bfilter forall a. Eq a => a -> a -> Bool
== BloomFlags
BloomUpdateNone = forall a. Maybe a
Nothing
    | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Word32, ScriptOutput)]
matchOuts) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' BloomFilter -> (Word32, ScriptOutput) -> BloomFilter
addRelevant BloomFilter
bfilter [(Word32, ScriptOutput)]
matchOuts
    | Bool
otherwise = forall a. Maybe a
Nothing
  where
    -- TxHash if we end up inserting an outpoint

    h :: TxHash
h = Tx -> TxHash
txHash Tx
tx
    -- Decode the scriptOutpus and add vOuts in case we make them outpoints
    decodedOutputScripts :: Either String [ScriptOutput]
decodedOutputScripts = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (ByteString -> Either String ScriptOutput
decodeOutputBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> ByteString
scriptOutput) forall a b. (a -> b) -> a -> b
$ Tx -> [TxOut]
txOut Tx
tx
    err :: a
err = forall a. HasCallStack => String -> a
error String
"Error Decoding output script"
    idxOutputScripts :: [(Word32, ScriptOutput)]
idxOutputScripts = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall {a}. a
err) (forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..]) Either String [ScriptOutput]
decodedOutputScripts
    -- Check if any txOuts were contained in the bloom filter
    matchFilter :: [(a, ScriptOutput)] -> [(a, ScriptOutput)]
matchFilter =
        forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
_, ScriptOutput
op) -> BloomFilter -> ByteString -> Bool
bloomContains BloomFilter
bfilter forall a b. (a -> b) -> a -> b
$ ScriptOutput -> ByteString
encodeScriptOut ScriptOutput
op)
    matchOuts :: [(Word32, ScriptOutput)]
matchOuts = forall {a}. [(a, ScriptOutput)] -> [(a, ScriptOutput)]
matchFilter [(Word32, ScriptOutput)]
idxOutputScripts
    addRelevant :: BloomFilter -> (Word32, ScriptOutput) -> BloomFilter
    addRelevant :: BloomFilter -> (Word32, ScriptOutput) -> BloomFilter
addRelevant BloomFilter
bf (Word32
id', ScriptOutput
scriptOut) =
        case (BloomFilter -> BloomFlags
bloomFlags BloomFilter
bfilter, Bool
scriptType) of
            -- We filtered out BloomUpdateNone so we insert any PayPk or PayMulSig

            (BloomFlags
_, Bool
True) -> BloomFilter -> ByteString -> BloomFilter
bloomInsert BloomFilter
bf ByteString
outpoint
            (BloomFlags
BloomUpdateAll, Bool
_) -> BloomFilter -> ByteString -> BloomFilter
bloomInsert BloomFilter
bf ByteString
outpoint
            (BloomFlags, Bool)
_ -> forall a. HasCallStack => String -> a
error String
"Error Updating Bloom Filter with relevant outpoint"
      where
        outpoint :: ByteString
outpoint = Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ OutPoint{outPointHash :: TxHash
outPointHash = TxHash
h, outPointIndex :: Word32
outPointIndex = Word32
id'}
        scriptType :: Bool
scriptType = (\ScriptOutput
s -> ScriptOutput -> Bool
isPayPK ScriptOutput
s Bool -> Bool -> Bool
|| ScriptOutput -> Bool
isPayMulSig ScriptOutput
s) ScriptOutput
scriptOut
    -- Encodes a scriptOutput so it can be checked agains the Bloom Filter
    encodeScriptOut :: ScriptOutput -> ByteString
    encodeScriptOut :: ScriptOutput -> ByteString
encodeScriptOut (PayMulSig [PubKeyI]
outputMuSig Int
_) = Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize [PubKeyI]
outputMuSig
    encodeScriptOut (PayWitnessScriptHash Hash256
scriptHash) = Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
scriptHash
    encodeScriptOut (DataCarrier ByteString
getOutputDat) = Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ByteString
getOutputDat
    encodeScriptOut ScriptOutput
outputHash = (Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> Hash160
getOutputHash) ScriptOutput
outputHash

-- | Returns True if the filter is empty (all bytes set to 0x00)
isBloomEmpty :: BloomFilter -> Bool
isBloomEmpty :: BloomFilter -> Bool
isBloomEmpty BloomFilter
bfilter = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Word8
0x00) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ BloomFilter -> Seq Word8
bloomData BloomFilter
bfilter

-- | Returns True if the filter is full (all bytes set to 0xff)
isBloomFull :: BloomFilter -> Bool
isBloomFull :: BloomFilter -> Bool
isBloomFull BloomFilter
bfilter = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Word8
0xff) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall a b. (a -> b) -> a -> b
$ BloomFilter -> Seq Word8
bloomData BloomFilter
bfilter

-- | Tests if a given bloom filter is valid.
isBloomValid ::
    -- | Bloom filter to test
    BloomFilter ->
    -- | True if the given filter is valid
    Bool
isBloomValid :: BloomFilter -> Bool
isBloomValid BloomFilter
bfilter =
    forall a. Seq a -> Int
S.length (BloomFilter -> Seq Word8
bloomData BloomFilter
bfilter) forall a. Ord a => a -> a -> Bool
<= Int
maxBloomSize
        Bool -> Bool -> Bool
&& BloomFilter -> Word32
bloomHashFuncs BloomFilter
bfilter forall a. Ord a => a -> a -> Bool
<= Word32
maxHashFuncs

-- | Does the peer with these version services accept bloom filters?
acceptsFilters :: Word64 -> Bool
acceptsFilters :: Word64 -> Bool
acceptsFilters Word64
srv = Word64
srv forall a. Bits a => a -> a -> a
.&. (Word64
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2) forall a. Eq a => a -> a -> Bool
/= Word64
0