{-# 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
(BloomFlags -> BloomFlags -> Bool)
-> (BloomFlags -> BloomFlags -> Bool) -> Eq BloomFlags
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
(Int -> BloomFlags -> ShowS)
-> (BloomFlags -> String)
-> ([BloomFlags] -> ShowS)
-> Show BloomFlags
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]
(Int -> ReadS BloomFlags)
-> ReadS [BloomFlags]
-> ReadPrec BloomFlags
-> ReadPrec [BloomFlags]
-> Read 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. BloomFlags -> Rep BloomFlags x)
-> (forall x. Rep BloomFlags x -> BloomFlags) -> Generic BloomFlags
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 -> ()
(BloomFlags -> ()) -> NFData BloomFlags
forall a. (a -> ()) -> NFData a
rnf :: BloomFlags -> ()
$crnf :: BloomFlags -> ()
NFData)

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

    serialize :: BloomFlags -> m ()
serialize BloomFlags
f = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word8 -> m ()) -> Word8 -> m ()
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 = Get BloomFlags
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    put :: BloomFlags -> Put
put = BloomFlags -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

instance Serialize BloomFlags where
    get :: Get BloomFlags
get = Get BloomFlags
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    put :: Putter BloomFlags
put = Putter BloomFlags
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
(BloomFilter -> BloomFilter -> Bool)
-> (BloomFilter -> BloomFilter -> Bool) -> Eq BloomFilter
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
(Int -> BloomFilter -> ShowS)
-> (BloomFilter -> String)
-> ([BloomFilter] -> ShowS)
-> Show BloomFilter
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]
(Int -> ReadS BloomFilter)
-> ReadS [BloomFilter]
-> ReadPrec BloomFilter
-> ReadPrec [BloomFilter]
-> Read 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. BloomFilter -> Rep BloomFilter x)
-> (forall x. Rep BloomFilter x -> BloomFilter)
-> Generic BloomFilter
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 -> ()
(BloomFilter -> ()) -> NFData BloomFilter
forall a. (a -> ()) -> NFData a
rnf :: BloomFilter -> ()
$crnf :: BloomFilter -> ()
NFData)

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

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

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

instance Serialize BloomFilter where
    put :: Putter BloomFilter
put = Putter BloomFilter
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get BloomFilter
get = Get BloomFilter
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
(FilterLoad -> FilterLoad -> Bool)
-> (FilterLoad -> FilterLoad -> Bool) -> Eq FilterLoad
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
(Int -> FilterLoad -> ShowS)
-> (FilterLoad -> String)
-> ([FilterLoad] -> ShowS)
-> Show FilterLoad
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]
(Int -> ReadS FilterLoad)
-> ReadS [FilterLoad]
-> ReadPrec FilterLoad
-> ReadPrec [FilterLoad]
-> Read 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. FilterLoad -> Rep FilterLoad x)
-> (forall x. Rep FilterLoad x -> FilterLoad) -> Generic FilterLoad
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 -> ()
(FilterLoad -> ()) -> NFData FilterLoad
forall a. (a -> ()) -> NFData a
rnf :: FilterLoad -> ()
$crnf :: FilterLoad -> ()
NFData)

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

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

instance Serialize FilterLoad where
    put :: Putter FilterLoad
put = Putter FilterLoad
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get FilterLoad
get = Get FilterLoad
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
(FilterAdd -> FilterAdd -> Bool)
-> (FilterAdd -> FilterAdd -> Bool) -> Eq FilterAdd
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
(Int -> FilterAdd -> ShowS)
-> (FilterAdd -> String)
-> ([FilterAdd] -> ShowS)
-> Show FilterAdd
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]
(Int -> ReadS FilterAdd)
-> ReadS [FilterAdd]
-> ReadPrec FilterAdd
-> ReadPrec [FilterAdd]
-> Read 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. FilterAdd -> Rep FilterAdd x)
-> (forall x. Rep FilterAdd x -> FilterAdd) -> Generic FilterAdd
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 -> ()
(FilterAdd -> ()) -> NFData FilterAdd
forall a. (a -> ()) -> NFData a
rnf :: FilterAdd -> ()
$crnf :: FilterAdd -> ()
NFData)

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

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

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

instance Serialize FilterAdd where
    put :: Putter FilterAdd
put = Putter FilterAdd
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get FilterAdd
get = Get FilterAdd
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 (Int -> Word8 -> Seq Word8
forall a. Int -> a -> Seq a
S.replicate Int
bloomSize Word8
0) Word32
numHashF
  where
    -- Bloom filter size in bytes
    bloomSize :: Int
bloomSize = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
a Double
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
8
    -- Suggested size in bits
    a :: Double
a = -Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
ln2Squared Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numElem Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log Double
fpRate
    -- Maximum size in bits
    b :: Double
b = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int
maxBloomSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
    numHashF :: Word32
numHashF = Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Word32) -> Double -> Word32
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
c (Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
maxHashFuncs)
    -- Suggested number of hash functions
    c :: Double
c = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bloomSize Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
8 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numElem Double -> Double -> Double
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 Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seq Word8 -> Int
forall a. Seq a -> Int
S.length (BloomFilter -> Seq Word8
bloomData BloomFilter
bfilter)) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
8)
  where
    seed :: Word32
seed = Word32
hashNum Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
0xfba4c795 Word32 -> Word32 -> Word32
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 = (Word32 -> Word32) -> [Word32] -> [Word32]
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 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1]
    upd :: Seq Word8 -> a -> Seq Word8
upd Seq Word8
s a
i =
        (Word8 -> Word8) -> Int -> Seq Word8 -> Seq Word8
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust
            (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. [Word8]
bitMask [Word8] -> Int -> Word8
forall a. [a] -> Int -> a
!! a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
7 a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
i))
            (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ a
i a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
            Seq Word8
s
    newData :: Seq Word8
newData = (Seq Word8 -> Word32 -> Seq Word8)
-> Seq Word8 -> [Word32] -> Seq Word8
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Seq Word8 -> Word32 -> Seq Word8
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 = (Word32 -> Bool) -> [Word32] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Word32 -> Bool
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 = (Word32 -> Word32) -> [Word32] -> [Word32]
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 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1]
    isSet :: a -> Bool
isSet a
i =
        Seq Word8 -> Int -> Word8
forall a. Seq a -> Int -> a
S.index Seq Word8
s (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ a
i a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
3)
            Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. ([Word8]
bitMask [Word8] -> Int -> Word8
forall a. [a] -> Int -> a
!! a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
7 a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
i)) Word8 -> Word8 -> Bool
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 = Maybe BloomFilter
forall a. Maybe a
Nothing
    | BloomFilter -> BloomFlags
bloomFlags BloomFilter
bfilter BloomFlags -> BloomFlags -> Bool
forall a. Eq a => a -> a -> Bool
== BloomFlags
BloomUpdateNone = Maybe BloomFilter
forall a. Maybe a
Nothing
    | Bool -> Bool
not ([(Word32, ScriptOutput)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Word32, ScriptOutput)]
matchOuts) = BloomFilter -> Maybe BloomFilter
forall a. a -> Maybe a
Just (BloomFilter -> Maybe BloomFilter)
-> BloomFilter -> Maybe BloomFilter
forall a b. (a -> b) -> a -> b
$ (BloomFilter -> (Word32, ScriptOutput) -> BloomFilter)
-> BloomFilter -> [(Word32, ScriptOutput)] -> BloomFilter
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 = Maybe BloomFilter
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 = (TxOut -> Either String ScriptOutput)
-> [TxOut] -> Either String [ScriptOutput]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (ByteString -> Either String ScriptOutput
decodeOutputBS (ByteString -> Either String ScriptOutput)
-> (TxOut -> ByteString) -> TxOut -> Either String ScriptOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> ByteString
scriptOutput) ([TxOut] -> Either String [ScriptOutput])
-> [TxOut] -> Either String [ScriptOutput]
forall a b. (a -> b) -> a -> b
$ Tx -> [TxOut]
txOut Tx
tx
    err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"Error Decoding output script"
    idxOutputScripts :: [(Word32, ScriptOutput)]
idxOutputScripts = (String -> [(Word32, ScriptOutput)])
-> ([ScriptOutput] -> [(Word32, ScriptOutput)])
-> Either String [ScriptOutput]
-> [(Word32, ScriptOutput)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([(Word32, ScriptOutput)] -> String -> [(Word32, ScriptOutput)]
forall a b. a -> b -> a
const [(Word32, ScriptOutput)]
forall a. a
err) ([Word32] -> [ScriptOutput] -> [(Word32, ScriptOutput)]
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 =
        ((a, ScriptOutput) -> Bool)
-> [(a, ScriptOutput)] -> [(a, ScriptOutput)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
_, ScriptOutput
op) -> BloomFilter -> ByteString -> Bool
bloomContains BloomFilter
bfilter (ByteString -> Bool) -> ByteString -> Bool
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> ByteString
encodeScriptOut ScriptOutput
op)
    matchOuts :: [(Word32, ScriptOutput)]
matchOuts = [(Word32, ScriptOutput)] -> [(Word32, ScriptOutput)]
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)
_ -> String -> BloomFilter
forall a. HasCallStack => String -> a
error String
"Error Updating Bloom Filter with relevant outpoint"
      where
        outpoint :: ByteString
outpoint = Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ OutPoint -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (OutPoint -> Put) -> OutPoint -> Put
forall a b. (a -> b) -> a -> b
$ OutPoint :: TxHash -> Word32 -> OutPoint
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 (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ [PubKeyI] -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize [PubKeyI]
outputMuSig
    encodeScriptOut (PayWitnessScriptHash Hash256
scriptHash) = Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
scriptHash
    encodeScriptOut (DataCarrier ByteString
getOutputDat) = Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ByteString
getOutputDat
    encodeScriptOut ScriptOutput
outputHash = (Put -> ByteString
runPutS (Put -> ByteString)
-> (ScriptOutput -> Put) -> ScriptOutput -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Hash160 -> Put)
-> (ScriptOutput -> Hash160) -> ScriptOutput -> Put
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 = (Word8 -> Bool) -> [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00) ([Word8] -> Bool) -> [Word8] -> Bool
forall a b. (a -> b) -> a -> b
$ Seq Word8 -> [Word8]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq Word8 -> [Word8]) -> Seq Word8 -> [Word8]
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 = (Word8 -> Bool) -> [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff) ([Word8] -> Bool) -> [Word8] -> Bool
forall a b. (a -> b) -> a -> b
$ Seq Word8 -> [Word8]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq Word8 -> [Word8]) -> Seq Word8 -> [Word8]
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 =
    Seq Word8 -> Int
forall a. Seq a -> Int
S.length (BloomFilter -> Seq Word8
bloomData BloomFilter
bfilter) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxBloomSize
        Bool -> Bool -> Bool
&& BloomFilter -> Word32
bloomHashFuncs BloomFilter
bfilter Word32 -> Word32 -> Bool
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 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0