{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Haskoin.Block.Merkle (
MerkleBlock (..),
MerkleRoot,
FlagBits,
PartialMerkleTree,
buildMerkleRoot,
merkleBlockTxs,
testMerkleRoot,
buildPartialMerkle,
decodeMerkleFlags,
encodeMerkleFlags,
calcTreeHeight,
calcTreeWidth,
hash2,
calcHash,
traverseAndBuild,
traverseAndExtract,
extractMatches,
splitIn,
boolsToWord8,
) where
import Control.DeepSeq
import Control.Monad (forM_, replicateM, when)
import Data.Binary (Binary (..))
import Data.Bits
import qualified Data.ByteString as BS
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Either (isRight)
import Data.Hashable
import Data.Maybe
import Data.Serialize (Serialize (..))
import Data.Word (Word32, Word8)
import GHC.Generics
import Haskoin.Block.Common
import Haskoin.Crypto.Hash
import Haskoin.Data
import Haskoin.Network.Common
import Haskoin.Transaction.Common
type MerkleRoot = Hash256
type FlagBits = [Bool]
type PartialMerkleTree = [Hash256]
data MerkleBlock = MerkleBlock
{
:: !BlockHeader
,
MerkleBlock -> Word32
merkleTotalTxns :: !Word32
,
MerkleBlock -> PartialMerkleTree
mHashes :: !PartialMerkleTree
,
MerkleBlock -> FlagBits
mFlags :: !FlagBits
}
deriving (MerkleBlock -> MerkleBlock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MerkleBlock -> MerkleBlock -> Bool
$c/= :: MerkleBlock -> MerkleBlock -> Bool
== :: MerkleBlock -> MerkleBlock -> Bool
$c== :: MerkleBlock -> MerkleBlock -> Bool
Eq, Int -> MerkleBlock -> ShowS
[MerkleBlock] -> ShowS
MerkleBlock -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MerkleBlock] -> ShowS
$cshowList :: [MerkleBlock] -> ShowS
show :: MerkleBlock -> String
$cshow :: MerkleBlock -> String
showsPrec :: Int -> MerkleBlock -> ShowS
$cshowsPrec :: Int -> MerkleBlock -> ShowS
Show, ReadPrec [MerkleBlock]
ReadPrec MerkleBlock
Int -> ReadS MerkleBlock
ReadS [MerkleBlock]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MerkleBlock]
$creadListPrec :: ReadPrec [MerkleBlock]
readPrec :: ReadPrec MerkleBlock
$creadPrec :: ReadPrec MerkleBlock
readList :: ReadS [MerkleBlock]
$creadList :: ReadS [MerkleBlock]
readsPrec :: Int -> ReadS MerkleBlock
$creadsPrec :: Int -> ReadS MerkleBlock
Read, forall x. Rep MerkleBlock x -> MerkleBlock
forall x. MerkleBlock -> Rep MerkleBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MerkleBlock x -> MerkleBlock
$cfrom :: forall x. MerkleBlock -> Rep MerkleBlock x
Generic, Eq MerkleBlock
Int -> MerkleBlock -> Int
MerkleBlock -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MerkleBlock -> Int
$chash :: MerkleBlock -> Int
hashWithSalt :: Int -> MerkleBlock -> Int
$chashWithSalt :: Int -> MerkleBlock -> Int
Hashable, MerkleBlock -> ()
forall a. (a -> ()) -> NFData a
rnf :: MerkleBlock -> ()
$crnf :: MerkleBlock -> ()
NFData)
instance Serial MerkleBlock where
deserialize :: forall (m :: * -> *). MonadGet m => m MerkleBlock
deserialize = do
BlockHeader
header <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
Word32
ntx <- forall (m :: * -> *). MonadGet m => m Word32
getWord32le
(VarInt Word64
matchLen) <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
PartialMerkleTree
hashes <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
matchLen) forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
(VarInt Word64
flagLen) <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
[Word8]
ws <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
flagLen) forall (m :: * -> *). MonadGet m => m Word8
getWord8
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockHeader
-> Word32 -> PartialMerkleTree -> FlagBits -> MerkleBlock
MerkleBlock BlockHeader
header Word32
ntx PartialMerkleTree
hashes ([Word8] -> FlagBits
decodeMerkleFlags [Word8]
ws)
serialize :: forall (m :: * -> *). MonadPut m => MerkleBlock -> m ()
serialize (MerkleBlock BlockHeader
h Word32
ntx PartialMerkleTree
hashes FlagBits
flags) = do
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHeader
h
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
ntx
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length PartialMerkleTree
hashes
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ PartialMerkleTree
hashes forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
let ws :: [Word8]
ws = FlagBits -> [Word8]
encodeMerkleFlags FlagBits
flags
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
ws
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word8]
ws forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8
instance Binary MerkleBlock where
put :: MerkleBlock -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get MerkleBlock
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Serialize MerkleBlock where
put :: Putter MerkleBlock
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get MerkleBlock
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
decodeMerkleFlags :: [Word8] -> FlagBits
decodeMerkleFlags :: [Word8] -> FlagBits
decodeMerkleFlags [Word8]
ws =
[ Bool
b | Int
p <- [Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
ws forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
- Int
1], Bool
b <- [forall a. Bits a => a -> Int -> Bool
testBit ([Word8]
ws forall a. [a] -> Int -> a
!! (Int
p forall a. Integral a => a -> a -> a
`div` Int
8)) (Int
p forall a. Integral a => a -> a -> a
`mod` Int
8)]
]
encodeMerkleFlags :: FlagBits -> [Word8]
encodeMerkleFlags :: FlagBits -> [Word8]
encodeMerkleFlags FlagBits
bs = forall a b. (a -> b) -> [a] -> [b]
map FlagBits -> Word8
boolsToWord8 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [[a]]
splitIn Int
8 FlagBits
bs
calcTreeHeight ::
Int ->
Int
calcTreeHeight :: Int -> Int
calcTreeHeight Int
ntx
| Int
ntx forall a. Ord a => a -> a -> Bool
< Int
2 = Int
0
| forall a. Integral a => a -> Bool
even Int
ntx = Int
1 forall a. Num a => a -> a -> a
+ Int -> Int
calcTreeHeight (Int
ntx forall a. Integral a => a -> a -> a
`div` Int
2)
| Bool
otherwise = Int -> Int
calcTreeHeight forall a b. (a -> b) -> a -> b
$ Int
ntx forall a. Num a => a -> a -> a
+ Int
1
calcTreeWidth ::
Int ->
Int ->
Int
calcTreeWidth :: Int -> Int -> Int
calcTreeWidth Int
ntx Int
h = (Int
ntx forall a. Num a => a -> a -> a
+ (Int
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
h) forall a. Num a => a -> a -> a
- Int
1) forall a. Bits a => a -> Int -> a
`shiftR` Int
h
buildMerkleRoot ::
[TxHash] ->
MerkleRoot
buildMerkleRoot :: [TxHash] -> Hash256
buildMerkleRoot [TxHash]
txs = Int -> Int -> [TxHash] -> Hash256
calcHash (Int -> Int
calcTreeHeight forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxHash]
txs) Int
0 [TxHash]
txs
hash2 :: Hash256 -> Hash256 -> Hash256
hash2 :: Hash256 -> Hash256 -> Hash256
hash2 Hash256
a Hash256
b = forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
a) forall a. Semigroup a => a -> a -> a
<> Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
b)
calcHash ::
Int ->
Int ->
[TxHash] ->
Hash256
calcHash :: Int -> Int -> [TxHash] -> Hash256
calcHash Int
height Int
pos [TxHash]
txs
| Int
height forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
pos forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => String -> a
error String
"calcHash: Invalid parameters"
| Int
height forall a. Eq a => a -> a -> Bool
== Int
0 = TxHash -> Hash256
getTxHash forall a b. (a -> b) -> a -> b
$ [TxHash]
txs forall a. [a] -> Int -> a
!! Int
pos
| Bool
otherwise = Hash256 -> Hash256 -> Hash256
hash2 Hash256
left Hash256
right
where
left :: Hash256
left = Int -> Int -> [TxHash] -> Hash256
calcHash (Int
height forall a. Num a => a -> a -> a
- Int
1) (Int
pos forall a. Num a => a -> a -> a
* Int
2) [TxHash]
txs
right :: Hash256
right
| Int
pos forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
< Int -> Int -> Int
calcTreeWidth (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxHash]
txs) (Int
height forall a. Num a => a -> a -> a
- Int
1) =
Int -> Int -> [TxHash] -> Hash256
calcHash (Int
height forall a. Num a => a -> a -> a
- Int
1) (Int
pos forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1) [TxHash]
txs
| Bool
otherwise = Hash256
left
buildPartialMerkle ::
[(TxHash, Bool)] ->
(FlagBits, PartialMerkleTree)
buildPartialMerkle :: [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree)
buildPartialMerkle [(TxHash, Bool)]
hs = Int -> Int -> [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree)
traverseAndBuild (Int -> Int
calcTreeHeight forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TxHash, Bool)]
hs) Int
0 [(TxHash, Bool)]
hs
traverseAndBuild ::
Int -> Int -> [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree)
traverseAndBuild :: Int -> Int -> [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree)
traverseAndBuild Int
height Int
pos [(TxHash, Bool)]
txs
| Int
height forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
pos forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => String -> a
error String
"traverseAndBuild: Invalid parameters"
| Int
height forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
match = ([Bool
match], [Int -> Int -> [TxHash] -> Hash256
calcHash Int
height Int
pos [TxHash]
t])
| Bool
otherwise = (Bool
match forall a. a -> [a] -> [a]
: FlagBits
lb forall a. [a] -> [a] -> [a]
++ FlagBits
rb, PartialMerkleTree
lh forall a. [a] -> [a] -> [a]
++ PartialMerkleTree
rh)
where
t :: [TxHash]
t = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(TxHash, Bool)]
txs
s :: Int
s = Int
pos forall a. Bits a => a -> Int -> a
`shiftL` Int
height
e :: Int
e = forall a. Ord a => a -> a -> a
min (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TxHash, Bool)]
txs) forall a b. (a -> b) -> a -> b
$ (Int
pos forall a. Num a => a -> a -> a
+ Int
1) forall a. Bits a => a -> Int -> a
`shiftL` Int
height
match :: Bool
match = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (Int
e forall a. Num a => a -> a -> a
- Int
s) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
s [(TxHash, Bool)]
txs
(FlagBits
lb, PartialMerkleTree
lh) = Int -> Int -> [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree)
traverseAndBuild (Int
height forall a. Num a => a -> a -> a
- Int
1) (Int
pos forall a. Num a => a -> a -> a
* Int
2) [(TxHash, Bool)]
txs
(FlagBits
rb, PartialMerkleTree
rh)
| (Int
pos forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1) forall a. Ord a => a -> a -> Bool
< Int -> Int -> Int
calcTreeWidth (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TxHash, Bool)]
txs) (Int
height forall a. Num a => a -> a -> a
- Int
1) =
Int -> Int -> [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree)
traverseAndBuild (Int
height forall a. Num a => a -> a -> a
- Int
1) (Int
pos forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1) [(TxHash, Bool)]
txs
| Bool
otherwise = ([], [])
traverseAndExtract ::
Int ->
Int ->
Int ->
FlagBits ->
PartialMerkleTree ->
Maybe (MerkleRoot, [TxHash], Int, Int)
traverseAndExtract :: Int
-> Int
-> Int
-> FlagBits
-> PartialMerkleTree
-> Maybe (Hash256, [TxHash], Int, Int)
traverseAndExtract Int
height Int
pos Int
ntx FlagBits
flags PartialMerkleTree
hashes
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlagBits
flags = forall a. Maybe a
Nothing
| Int
height forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
match = Maybe (Hash256, [TxHash], Int, Int)
leafResult
| forall a. Maybe a -> Bool
isNothing Maybe (Hash256, [TxHash], Int, Int)
leftM = forall a. Maybe a
Nothing
| (Int
pos forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1) forall a. Ord a => a -> a -> Bool
>= Int -> Int -> Int
calcTreeWidth Int
ntx (Int
height forall a. Num a => a -> a -> a
- Int
1) =
forall a. a -> Maybe a
Just (Hash256 -> Hash256 -> Hash256
hash2 Hash256
lh Hash256
lh, [TxHash]
lm, Int
lcf forall a. Num a => a -> a -> a
+ Int
1, Int
lch)
| forall a. Maybe a -> Bool
isNothing Maybe (Hash256, [TxHash], Int, Int)
rightM = forall a. Maybe a
Nothing
| Bool
otherwise =
forall a. a -> Maybe a
Just (Hash256 -> Hash256 -> Hash256
hash2 Hash256
lh Hash256
rh, [TxHash]
lm forall a. [a] -> [a] -> [a]
++ [TxHash]
rm, Int
lcf forall a. Num a => a -> a -> a
+ Int
rcf forall a. Num a => a -> a -> a
+ Int
1, Int
lch forall a. Num a => a -> a -> a
+ Int
rch)
where
leafResult :: Maybe (Hash256, [TxHash], Int, Int)
leafResult
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null PartialMerkleTree
hashes = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (Hash256
h, [Hash256 -> TxHash
TxHash Hash256
h | Int
height forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool
match], Int
1, Int
1)
(Bool
match : FlagBits
fs) = FlagBits
flags
(Hash256
h : PartialMerkleTree
_) = PartialMerkleTree
hashes
leftM :: Maybe (Hash256, [TxHash], Int, Int)
leftM = Int
-> Int
-> Int
-> FlagBits
-> PartialMerkleTree
-> Maybe (Hash256, [TxHash], Int, Int)
traverseAndExtract (Int
height forall a. Num a => a -> a -> a
- Int
1) (Int
pos forall a. Num a => a -> a -> a
* Int
2) Int
ntx FlagBits
fs PartialMerkleTree
hashes
(Hash256
lh, [TxHash]
lm, Int
lcf, Int
lch) = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e Maybe (Hash256, [TxHash], Int, Int)
leftM
rightM :: Maybe (Hash256, [TxHash], Int, Int)
rightM =
Int
-> Int
-> Int
-> FlagBits
-> PartialMerkleTree
-> Maybe (Hash256, [TxHash], Int, Int)
traverseAndExtract
(Int
height forall a. Num a => a -> a -> a
- Int
1)
(Int
pos forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1)
Int
ntx
(forall a. Int -> [a] -> [a]
drop Int
lcf FlagBits
fs)
(forall a. Int -> [a] -> [a]
drop Int
lch PartialMerkleTree
hashes)
(Hash256
rh, [TxHash]
rm, Int
rcf, Int
rch) = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e Maybe (Hash256, [TxHash], Int, Int)
rightM
e :: a
e = forall a. HasCallStack => String -> a
error String
"traverseAndExtract: unexpected error extracting a Maybe value"
extractMatches ::
Network ->
FlagBits ->
PartialMerkleTree ->
Int ->
Either String (MerkleRoot, [TxHash])
Network
net FlagBits
flags PartialMerkleTree
hashes Int
ntx
| Int
ntx forall a. Eq a => a -> a -> Bool
== Int
0 =
forall a b. a -> Either a b
Left
String
"extractMatches: number of transactions can not be 0"
| Int
ntx forall a. Ord a => a -> a -> Bool
> Network -> Int
getMaxBlockSize Network
net forall a. Integral a => a -> a -> a
`div` Int
60 =
forall a b. a -> Either a b
Left
String
"extractMatches: number of transactions excessively high"
| forall (t :: * -> *) a. Foldable t => t a -> Int
length PartialMerkleTree
hashes forall a. Ord a => a -> a -> Bool
> Int
ntx =
forall a b. a -> Either a b
Left
String
"extractMatches: More hashes provided than the number of transactions"
| forall (t :: * -> *) a. Foldable t => t a -> Int
length FlagBits
flags forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length PartialMerkleTree
hashes =
forall a b. a -> Either a b
Left
String
"extractMatches: At least one bit per node and one bit per hash"
| forall a. Maybe a -> Bool
isNothing Maybe (Hash256, [TxHash], Int, Int)
resM =
forall a b. a -> Either a b
Left
String
"extractMatches: traverseAndExtract failed"
| (Int
nBitsUsed forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`div` Int
8 forall a. Eq a => a -> a -> Bool
/= (forall (t :: * -> *) a. Foldable t => t a -> Int
length FlagBits
flags forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`div` Int
8 =
forall a b. a -> Either a b
Left
String
"extractMatches: All bits were not consumed"
| Int
nHashUsed forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length PartialMerkleTree
hashes =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
String
"extractMatches: All hashes were not consumed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
nHashUsed
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return (Hash256
merkRoot, [TxHash]
matches)
where
resM :: Maybe (Hash256, [TxHash], Int, Int)
resM = Int
-> Int
-> Int
-> FlagBits
-> PartialMerkleTree
-> Maybe (Hash256, [TxHash], Int, Int)
traverseAndExtract (Int -> Int
calcTreeHeight Int
ntx) Int
0 Int
ntx FlagBits
flags PartialMerkleTree
hashes
(Hash256
merkRoot, [TxHash]
matches, Int
nBitsUsed, Int
nHashUsed) = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e Maybe (Hash256, [TxHash], Int, Int)
resM
e :: a
e = forall a. HasCallStack => String -> a
error String
"extractMatches: unexpected error extracting a Maybe value"
splitIn :: Int -> [a] -> [[a]]
splitIn :: forall a. Int -> [a] -> [[a]]
splitIn Int
_ [] = []
splitIn Int
c [a]
xs = [a]
xs1 forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [[a]]
splitIn Int
c [a]
xs2
where
([a]
xs1, [a]
xs2) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
c [a]
xs
boolsToWord8 :: [Bool] -> Word8
boolsToWord8 :: FlagBits -> Word8
boolsToWord8 [] = Word8
0
boolsToWord8 FlagBits
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Bits a => a -> Int -> a
setBit Word8
0 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip FlagBits
xs [Int
0 .. Int
7])
merkleBlockTxs :: Network -> MerkleBlock -> Either String [TxHash]
merkleBlockTxs :: Network -> MerkleBlock -> Either String [TxHash]
merkleBlockTxs Network
net MerkleBlock
b =
let flags :: FlagBits
flags = MerkleBlock -> FlagBits
mFlags MerkleBlock
b
hs :: PartialMerkleTree
hs = MerkleBlock -> PartialMerkleTree
mHashes MerkleBlock
b
n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ MerkleBlock -> Word32
merkleTotalTxns MerkleBlock
b
merkle :: Hash256
merkle = BlockHeader -> Hash256
merkleRoot forall a b. (a -> b) -> a -> b
$ MerkleBlock -> BlockHeader
merkleHeader MerkleBlock
b
in do
(Hash256
root, [TxHash]
ths) <- Network
-> FlagBits
-> PartialMerkleTree
-> Int
-> Either String (Hash256, [TxHash])
extractMatches Network
net FlagBits
flags PartialMerkleTree
hs Int
n
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Hash256
root forall a. Eq a => a -> a -> Bool
/= Hash256
merkle) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"merkleBlockTxs: Merkle root incorrect"
forall (m :: * -> *) a. Monad m => a -> m a
return [TxHash]
ths
testMerkleRoot :: Network -> MerkleBlock -> Bool
testMerkleRoot :: Network -> MerkleBlock -> Bool
testMerkleRoot Network
net = forall a b. Either a b -> Bool
isRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> MerkleBlock -> Either String [TxHash]
merkleBlockTxs Network
net