{-# 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 = 36000

maxHashFuncs :: Word32
maxHashFuncs :: Word32
maxHashFuncs = 50

ln2Squared :: Double
ln2Squared :: Double
ln2Squared = 0.4804530139182014246671025263266649717305529515945455

ln2 :: Double
ln2 :: Double
ln2 = 0.6931471805599453094172321214581765680755001343602552

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

-- | The bloom flags are used to tell the remote peer how to auto-update
-- the provided bloom filter.
data BloomFlags
    = BloomUpdateNone -- ^ never update
    | BloomUpdateAll -- ^ auto-update on all outputs
    | BloomUpdateP2PubKeyOnly
    -- ^ auto-update on pay-to-pubkey or pay-to-multisig (default)
    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 0 = BloomFlags -> m BloomFlags
forall (m :: * -> *) a. Monad m => a -> m a
return BloomFlags
BloomUpdateNone
        go 1 = BloomFlags -> m BloomFlags
forall (m :: * -> *) a. Monad m => a -> m a
return BloomFlags
BloomUpdateAll
        go 2 = BloomFlags -> m BloomFlags
forall (m :: * -> *) a. Monad m => a -> m a
return BloomFlags
BloomUpdateP2PubKeyOnly
        go _ = String -> m BloomFlags
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "BloomFlags get: Invalid bloom flag"

    serialize :: BloomFlags -> m ()
serialize f :: 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
        BloomUpdateNone         -> 0
        BloomUpdateAll          -> 1
        BloomUpdateP2PubKeyOnly -> 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
    { BloomFilter -> Seq Word8
bloomData      :: !(S.Seq Word8)
    -- ^ bloom filter data
    , BloomFilter -> Word32
bloomHashFuncs :: !Word32
    -- ^ number of hash functions for this filter
    , BloomFilter -> Word32
bloomTweak     :: !Word32
    -- ^ hash function random nonce
    , BloomFilter -> BloomFlags
bloomFlags     :: !BloomFlags
    -- ^ bloom filter auto-update flags
    }
    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 len :: 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 dat :: Seq Word8
dat hashFuncs :: Word32
hashFuncs tweak :: Word32
tweak flags :: 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 f :: 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 len :: 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 bs :: 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 :: Int          -- ^ number of elements
            -> Double       -- ^ false positive rate
            -> Word32       -- ^ random nonce (tweak) for the hash function
            -> BloomFlags   -- ^ bloom filter flags
            -> BloomFilter  -- ^ bloom filter
bloomCreate :: Int -> Double -> Word32 -> BloomFlags -> BloomFilter
bloomCreate numElem :: Int
numElem fpRate :: Double
fpRate =
    Seq Word8 -> Word32 -> Word32 -> BloomFlags -> BloomFilter
BloomFilter (Int -> Word8 -> Seq Word8
forall a. Int -> a -> Seq a
S.replicate Int
bloomSize 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
/ 8
    -- Suggested size in bits
    a :: Double
a         = -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
* 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
* 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 bfilter :: BloomFilter
bfilter hashNum :: Word32
hashNum bs :: 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
* 8)
  where
    seed :: Word32
seed = Word32
hashNum Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* 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 :: BloomFilter    -- ^ Original bloom filter
            -> ByteString     -- ^ New data to insert
            -> BloomFilter    -- ^ Bloom filter containing the new data
bloomInsert :: BloomFilter -> ByteString -> BloomFilter
bloomInsert bfilter :: BloomFilter
bfilter bs :: 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 (\i :: Word32
i -> BloomFilter -> Word32 -> ByteString -> Word32
bloomHash BloomFilter
bfilter Word32
i ByteString
bs) [0..BloomFilter -> Word32
bloomHashFuncs BloomFilter
bfilter Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- 1]
    upd :: Seq Word8 -> a -> Seq Word8
upd s :: Seq Word8
s i :: 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 (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` 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 :: BloomFilter    -- ^ Bloom filter
              -> ByteString
              -- ^ Data that will be checked against the given bloom filter
              -> Bool
              -- ^ Returns True if the data matches the filter
bloomContains :: BloomFilter -> ByteString -> Bool
bloomContains bfilter :: BloomFilter
bfilter bs :: 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 (\i :: Word32
i -> BloomFilter -> Word32 -> ByteString -> Word32
bloomHash BloomFilter
bfilter Word32
i ByteString
bs) [0..BloomFilter -> Word32
bloomHashFuncs BloomFilter
bfilter Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- 1]
    isSet :: a -> Bool
isSet i :: 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` 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 (7 a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
i)) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 :: BloomFilter
                    -- ^ Bloom filter
                    -> Tx
                    -- ^ Tx that may (or may not) have relevant outputs
                    -> Maybe BloomFilter
                    -- ^ Returns an updated bloom filter adding relevant output
bloomRelevantUpdate :: BloomFilter -> Tx -> Maybe BloomFilter
bloomRelevantUpdate bfilter :: BloomFilter
bfilter tx :: 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
        -- TxHash if we end up inserting an outpoint
  where
    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 "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 [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 (\(_, op :: 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 bf :: BloomFilter
bf (id' :: Word32
id', scriptOut :: ScriptOutput
scriptOut) =
        case (BloomFilter -> BloomFlags
bloomFlags BloomFilter
bfilter, Bool
scriptType)
            -- We filtered out BloomUpdateNone so we insert any PayPk or PayMulSig
              of
            (_, True) -> BloomFilter -> ByteString -> BloomFilter
bloomInsert BloomFilter
bf ByteString
outpoint
            (BloomUpdateAll, _) -> BloomFilter -> ByteString -> BloomFilter
bloomInsert BloomFilter
bf ByteString
outpoint
            _ -> String -> BloomFilter
forall a. HasCallStack => String -> a
error "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
$ $WOutPoint :: TxHash -> Word32 -> OutPoint
OutPoint {outPointHash :: TxHash
outPointHash = TxHash
h, outPointIndex :: Word32
outPointIndex = Word32
id'}
        scriptType :: Bool
scriptType = (\s :: 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 outputMuSig :: [PubKeyI]
outputMuSig _) = 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 scriptHash :: 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 getOutputDat :: 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 outputHash :: 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 bfilter :: 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
== 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 bfilter :: 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
== 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 :: BloomFilter -- ^ Bloom filter to test
             -> Bool        -- ^ True if the given filter is valid
isBloomValid :: BloomFilter -> Bool
isBloomValid bfilter :: 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 srv :: Word64
srv = Word64
srv Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 2) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0