{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Haskoin.Block.Headers (
BlockNode (..),
BlockHeaders (..),
BlockWork,
genesisNode,
genesisBlock,
isGenesis,
chooseBest,
parentBlock,
getParents,
getAncestor,
splitPoint,
connectBlocks,
connectBlock,
blockLocator,
HeaderMemory (..),
ShortBlockHash,
BlockMap,
shortBlockHash,
initialChain,
genesisMap,
appendBlocks,
validBlock,
validCP,
afterLastCP,
bip34,
validVersion,
lastNoMinDiff,
nextWorkRequired,
nextEdaWorkRequired,
nextDaaWorkRequired,
nextAsertWorkRequired,
computeAsertBits,
computeTarget,
getSuitableBlock,
nextPowWorkRequired,
calcNextWork,
isValidPOW,
blockPOW,
headerWork,
diffInterval,
blockLocatorNodes,
mineBlock,
computeSubsidy,
mtp,
firstGreaterOrEqual,
lastSmallerOrEqual,
) where
import Control.Applicative ((<|>))
import Control.DeepSeq
import Control.Monad (guard, mzero, unless, when)
import Control.Monad.Except (
ExceptT (..),
runExceptT,
throwError,
)
import Control.Monad.State.Strict as State (
StateT,
get,
gets,
lift,
modify,
)
import Control.Monad.Trans.Maybe
import Data.Binary (Binary (..))
import Data.Bits (shiftL, shiftR, (.&.))
import qualified Data.ByteString as B
import Data.ByteString.Short (
ShortByteString,
fromShort,
toShort,
)
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Function (on)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Hashable
import Data.List (sort, sortBy)
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Serialize (Serialize (..))
import Data.Typeable (Typeable)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Haskoin.Block.Common
import Haskoin.Crypto
import Haskoin.Data
import Haskoin.Transaction.Genesis
import Haskoin.Util
type ShortBlockHash = Word64
type BlockMap = HashMap ShortBlockHash ShortByteString
type BlockWork = Integer
data BlockNode = BlockNode
{ :: !BlockHeader
, BlockNode -> BlockHeight
nodeHeight :: !BlockHeight
,
BlockNode -> BlockWork
nodeWork :: !BlockWork
,
BlockNode -> BlockHash
nodeSkip :: !BlockHash
}
deriving (Int -> BlockNode -> ShowS
[BlockNode] -> ShowS
BlockNode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockNode] -> ShowS
$cshowList :: [BlockNode] -> ShowS
show :: BlockNode -> String
$cshow :: BlockNode -> String
showsPrec :: Int -> BlockNode -> ShowS
$cshowsPrec :: Int -> BlockNode -> ShowS
Show, ReadPrec [BlockNode]
ReadPrec BlockNode
Int -> ReadS BlockNode
ReadS [BlockNode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BlockNode]
$creadListPrec :: ReadPrec [BlockNode]
readPrec :: ReadPrec BlockNode
$creadPrec :: ReadPrec BlockNode
readList :: ReadS [BlockNode]
$creadList :: ReadS [BlockNode]
readsPrec :: Int -> ReadS BlockNode
$creadsPrec :: Int -> ReadS BlockNode
Read, forall x. Rep BlockNode x -> BlockNode
forall x. BlockNode -> Rep BlockNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockNode x -> BlockNode
$cfrom :: forall x. BlockNode -> Rep BlockNode x
Generic, Eq BlockNode
Int -> BlockNode -> Int
BlockNode -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlockNode -> Int
$chash :: BlockNode -> Int
hashWithSalt :: Int -> BlockNode -> Int
$chashWithSalt :: Int -> BlockNode -> Int
Hashable, BlockNode -> ()
forall a. (a -> ()) -> NFData a
rnf :: BlockNode -> ()
$crnf :: BlockNode -> ()
NFData)
instance Serial BlockNode where
deserialize :: forall (m :: * -> *). MonadGet m => m BlockNode
deserialize = do
BlockHeader
nodeHeader <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
BlockHeight
nodeHeight <- forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32le
BlockWork
nodeWork <- forall (m :: * -> *). MonadGet m => m BlockWork
getInteger
if BlockHeight
nodeHeight forall a. Eq a => a -> a -> Bool
== BlockHeight
0
then do
let nodeSkip :: BlockHash
nodeSkip = BlockHeader -> BlockHash
headerHash BlockHeader
nodeHeader
forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode{BlockWork
BlockHeight
BlockHeader
BlockHash
nodeSkip :: BlockHash
nodeWork :: BlockWork
nodeHeight :: BlockHeight
nodeHeader :: BlockHeader
nodeSkip :: BlockHash
nodeWork :: BlockWork
nodeHeight :: BlockHeight
nodeHeader :: BlockHeader
..}
else do
BlockHash
nodeSkip <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode{BlockWork
BlockHeight
BlockHeader
BlockHash
nodeSkip :: BlockHash
nodeWork :: BlockWork
nodeHeight :: BlockHeight
nodeHeader :: BlockHeader
nodeSkip :: BlockHash
nodeWork :: BlockWork
nodeHeight :: BlockHeight
nodeHeader :: BlockHeader
..}
serialize :: forall (m :: * -> *). MonadPut m => BlockNode -> m ()
serialize BlockNode
bn = do
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
bn
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32le forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeight
nodeHeight BlockNode
bn
forall (m :: * -> *). MonadPut m => BlockWork -> m ()
putInteger forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockWork
nodeWork BlockNode
bn
case BlockNode -> BlockHeight
nodeHeight BlockNode
bn of
BlockHeight
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
BlockHeight
_ -> forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHash
nodeSkip BlockNode
bn
instance Serialize BlockNode where
put :: Putter BlockNode
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get BlockNode
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Binary BlockNode where
put :: BlockNode -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get BlockNode
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Eq BlockNode where
== :: BlockNode -> BlockNode -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockNode -> BlockHeader
nodeHeader
instance Ord BlockNode where
compare :: BlockNode -> BlockNode -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockNode -> BlockHeight
nodeHeight
data =
{ :: !BlockMap
, :: !BlockNode
}
deriving (HeaderMemory -> HeaderMemory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderMemory -> HeaderMemory -> Bool
$c/= :: HeaderMemory -> HeaderMemory -> Bool
== :: HeaderMemory -> HeaderMemory -> Bool
$c== :: HeaderMemory -> HeaderMemory -> Bool
Eq, Typeable, Int -> HeaderMemory -> ShowS
[HeaderMemory] -> ShowS
HeaderMemory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderMemory] -> ShowS
$cshowList :: [HeaderMemory] -> ShowS
show :: HeaderMemory -> String
$cshow :: HeaderMemory -> String
showsPrec :: Int -> HeaderMemory -> ShowS
$cshowsPrec :: Int -> HeaderMemory -> ShowS
Show, ReadPrec [HeaderMemory]
ReadPrec HeaderMemory
Int -> ReadS HeaderMemory
ReadS [HeaderMemory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeaderMemory]
$creadListPrec :: ReadPrec [HeaderMemory]
readPrec :: ReadPrec HeaderMemory
$creadPrec :: ReadPrec HeaderMemory
readList :: ReadS [HeaderMemory]
$creadList :: ReadS [HeaderMemory]
readsPrec :: Int -> ReadS HeaderMemory
$creadsPrec :: Int -> ReadS HeaderMemory
Read, forall x. Rep HeaderMemory x -> HeaderMemory
forall x. HeaderMemory -> Rep HeaderMemory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HeaderMemory x -> HeaderMemory
$cfrom :: forall x. HeaderMemory -> Rep HeaderMemory x
Generic, Eq HeaderMemory
Int -> HeaderMemory -> Int
HeaderMemory -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HeaderMemory -> Int
$chash :: HeaderMemory -> Int
hashWithSalt :: Int -> HeaderMemory -> Int
$chashWithSalt :: Int -> HeaderMemory -> Int
Hashable, HeaderMemory -> ()
forall a. (a -> ()) -> NFData a
rnf :: HeaderMemory -> ()
$crnf :: HeaderMemory -> ()
NFData)
class Monad m => m where
:: BlockNode -> m ()
:: BlockHash -> m (Maybe BlockNode)
:: m BlockNode
:: BlockNode -> m ()
:: [BlockNode] -> m ()
addBlockHeaders = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). BlockHeaders m => BlockNode -> m ()
addBlockHeader
instance Monad m => BlockHeaders (StateT HeaderMemory m) where
addBlockHeader :: BlockNode -> StateT HeaderMemory m ()
addBlockHeader = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> HeaderMemory -> HeaderMemory
addBlockHeaderMemory
getBlockHeader :: BlockHash -> StateT HeaderMemory m (Maybe BlockNode)
getBlockHeader BlockHash
bh = BlockHash -> HeaderMemory -> Maybe BlockNode
getBlockHeaderMemory BlockHash
bh forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
State.get
getBestBlockHeader :: StateT HeaderMemory m BlockNode
getBestBlockHeader = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HeaderMemory -> BlockNode
memoryBestHeader
setBestBlockHeader :: BlockNode -> StateT HeaderMemory m ()
setBestBlockHeader BlockNode
bn = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \HeaderMemory
s -> HeaderMemory
s{memoryBestHeader :: BlockNode
memoryBestHeader = BlockNode
bn}
initialChain :: Network -> HeaderMemory
initialChain :: Network -> HeaderMemory
initialChain Network
net =
HeaderMemory
{ memoryHeaderMap :: BlockMap
memoryHeaderMap = Network -> BlockMap
genesisMap Network
net
, memoryBestHeader :: BlockNode
memoryBestHeader = Network -> BlockNode
genesisNode Network
net
}
genesisMap :: Network -> BlockMap
genesisMap :: Network -> BlockMap
genesisMap Network
net =
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton
(BlockHash -> Word64
shortBlockHash (BlockHeader -> BlockHash
headerHash (Network -> BlockHeader
getGenesisHeader Network
net)))
(ByteString -> ShortByteString
toShort (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Network -> BlockNode
genesisNode Network
net))))
addBlockHeaderMemory :: BlockNode -> HeaderMemory -> HeaderMemory
BlockNode
bn s :: HeaderMemory
s@HeaderMemory{BlockMap
BlockNode
memoryBestHeader :: BlockNode
memoryHeaderMap :: BlockMap
memoryBestHeader :: HeaderMemory -> BlockNode
memoryHeaderMap :: HeaderMemory -> BlockMap
..} =
let bm' :: BlockMap
bm' = BlockNode -> BlockMap -> BlockMap
addBlockToMap BlockNode
bn BlockMap
memoryHeaderMap
in HeaderMemory
s{memoryHeaderMap :: BlockMap
memoryHeaderMap = BlockMap
bm'}
getBlockHeaderMemory :: BlockHash -> HeaderMemory -> Maybe BlockNode
BlockHash
bh HeaderMemory{BlockMap
BlockNode
memoryBestHeader :: BlockNode
memoryHeaderMap :: BlockMap
memoryBestHeader :: HeaderMemory -> BlockNode
memoryHeaderMap :: HeaderMemory -> BlockMap
..} = do
ShortByteString
bs <- BlockHash -> Word64
shortBlockHash BlockHash
bh forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` BlockMap
memoryHeaderMap
forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
fromShort ShortByteString
bs
shortBlockHash :: BlockHash -> ShortBlockHash
shortBlockHash :: BlockHash -> Word64
shortBlockHash =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
addBlockToMap :: BlockNode -> BlockMap -> BlockMap
addBlockToMap :: BlockNode -> BlockMap -> BlockMap
addBlockToMap BlockNode
node =
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert
(BlockHash -> Word64
shortBlockHash forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHash
headerHash forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
node)
(ByteString -> ShortByteString
toShort forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockNode
node)
getAncestor ::
BlockHeaders m =>
BlockHeight ->
BlockNode ->
m (Maybe BlockNode)
getAncestor :: forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
height BlockNode
node
| BlockHeight
height forall a. Ord a => a -> a -> Bool
> BlockNode -> BlockHeight
nodeHeight BlockNode
node = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = forall {m :: * -> *}.
BlockHeaders m =>
BlockNode -> m (Maybe BlockNode)
go BlockNode
node
where
e1 :: a
e1 = forall a. HasCallStack => String -> a
error String
"Could not get skip header"
e2 :: a
e2 = forall a. HasCallStack => String -> a
error String
"Could not get previous block header"
go :: BlockNode -> m (Maybe BlockNode)
go BlockNode
walk
| BlockNode -> BlockHeight
nodeHeight BlockNode
walk forall a. Ord a => a -> a -> Bool
> BlockHeight
height =
let heightSkip :: BlockHeight
heightSkip = BlockHeight -> BlockHeight
skipHeight (BlockNode -> BlockHeight
nodeHeight BlockNode
walk)
heightSkipPrev :: BlockHeight
heightSkipPrev = BlockHeight -> BlockHeight
skipHeight (BlockNode -> BlockHeight
nodeHeight BlockNode
walk forall a. Num a => a -> a -> a
- BlockHeight
1)
in if Bool -> Bool
not (BlockNode -> Bool
isGenesis BlockNode
walk)
Bool -> Bool -> Bool
&& ( BlockHeight
heightSkip forall a. Eq a => a -> a -> Bool
== BlockHeight
height
Bool -> Bool -> Bool
|| ( BlockHeight
heightSkip forall a. Ord a => a -> a -> Bool
> BlockHeight
height
Bool -> Bool -> Bool
&& Bool -> Bool
not
( BlockHeight
heightSkipPrev forall a. Ord a => a -> a -> Bool
< BlockHeight
heightSkip forall a. Num a => a -> a -> a
- BlockHeight
2
Bool -> Bool -> Bool
&& BlockHeight
heightSkipPrev forall a. Ord a => a -> a -> Bool
>= BlockHeight
height
)
)
)
then do
BlockNode
walk' <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHash -> m (Maybe BlockNode)
getBlockHeader (BlockNode -> BlockHash
nodeSkip BlockNode
walk)
BlockNode -> m (Maybe BlockNode)
go BlockNode
walk'
else do
BlockNode
walk' <-
forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHash -> m (Maybe BlockNode)
getBlockHeader (BlockHeader -> BlockHash
prevBlock (BlockNode -> BlockHeader
nodeHeader BlockNode
walk))
BlockNode -> m (Maybe BlockNode)
go BlockNode
walk'
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just BlockNode
walk
isGenesis :: BlockNode -> Bool
isGenesis :: BlockNode -> Bool
isGenesis BlockNode{nodeHeight :: BlockNode -> BlockHeight
nodeHeight = BlockHeight
0} = Bool
True
isGenesis BlockNode
_ = Bool
False
genesisNode :: Network -> BlockNode
genesisNode :: Network -> BlockNode
genesisNode Network
net =
BlockNode
{ nodeHeader :: BlockHeader
nodeHeader = Network -> BlockHeader
getGenesisHeader Network
net
, nodeHeight :: BlockHeight
nodeHeight = BlockHeight
0
, nodeWork :: BlockWork
nodeWork = BlockHeader -> BlockWork
headerWork (Network -> BlockHeader
getGenesisHeader Network
net)
, nodeSkip :: BlockHash
nodeSkip = BlockHeader -> BlockHash
headerHash (Network -> BlockHeader
getGenesisHeader Network
net)
}
connectBlocks ::
BlockHeaders m =>
Network ->
Timestamp ->
[BlockHeader] ->
m (Either String [BlockNode])
connectBlocks :: forall (m :: * -> *).
BlockHeaders m =>
Network
-> BlockHeight -> [BlockHeader] -> m (Either String [BlockNode])
connectBlocks Network
_ BlockHeight
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right []
connectBlocks Network
net BlockHeight
t bhs :: [BlockHeader]
bhs@(BlockHeader
bh : [BlockHeader]
_) =
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([BlockHeader] -> Bool
chained [BlockHeader]
bhs) forall a b. (a -> b) -> a -> b
$
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Blocks to connect do not form a chain"
BlockNode
par <-
forall (m :: * -> *) e a.
Functor m =>
e -> MaybeT m a -> ExceptT e m a
maybeToExceptT
String
"Could not get parent block"
(forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (m :: * -> *).
BlockHeaders m =>
BlockHeader -> m (Maybe BlockNode)
parentBlock BlockHeader
bh))
[BlockNode]
pars <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
Int -> BlockNode -> m [BlockNode]
getParents Int
10 BlockNode
par
BlockNode
bb <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). BlockHeaders m => m BlockNode
getBestBlockHeader
forall {m :: * -> *}.
BlockHeaders m =>
BlockNode
-> [BlockNode]
-> BlockNode
-> BlockNode
-> [BlockNode]
-> [BlockHeader]
-> ExceptT String m [BlockNode]
go BlockNode
par [] BlockNode
bb BlockNode
par [BlockNode]
pars [BlockHeader]
bhs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
bns :: [BlockNode]
bns@(BlockNode
bn : [BlockNode]
_) -> do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). BlockHeaders m => [BlockNode] -> m ()
addBlockHeaders [BlockNode]
bns
let bb' :: BlockNode
bb' = BlockNode -> BlockNode -> BlockNode
chooseBest BlockNode
bn BlockNode
bb
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BlockNode
bb' forall a. Eq a => a -> a -> Bool
/= BlockNode
bb) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). BlockHeaders m => BlockNode -> m ()
setBestBlockHeader BlockNode
bb'
forall (m :: * -> *) a. Monad m => a -> m a
return [BlockNode]
bns
[BlockNode]
_ -> forall a. HasCallStack => a
undefined
where
chained :: [BlockHeader] -> Bool
chained (BlockHeader
h1 : BlockHeader
h2 : [BlockHeader]
hs) = BlockHeader -> BlockHash
headerHash BlockHeader
h1 forall a. Eq a => a -> a -> Bool
== BlockHeader -> BlockHash
prevBlock BlockHeader
h2 Bool -> Bool -> Bool
&& [BlockHeader] -> Bool
chained (BlockHeader
h2 forall a. a -> [a] -> [a]
: [BlockHeader]
hs)
chained [BlockHeader]
_ = Bool
True
skipit :: BlockNode -> [BlockNode] -> BlockNode -> t m BlockNode
skipit BlockNode
lbh [BlockNode]
ls BlockNode
par
| BlockHeight
sh forall a. Eq a => a -> a -> Bool
== BlockNode -> BlockHeight
nodeHeight BlockNode
lbh = forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
lbh
| BlockHeight
sh forall a. Ord a => a -> a -> Bool
< BlockNode -> BlockHeight
nodeHeight BlockNode
lbh = do
Maybe BlockNode
skM <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
sh BlockNode
lbh
case Maybe BlockNode
skM of
Just BlockNode
sk -> forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
sk
Maybe BlockNode
Nothing ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
String
"BUG: Could not get skip for block "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (BlockHeader -> BlockHash
headerHash forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
par)
| Bool
otherwise = do
let sn :: BlockNode
sn = [BlockNode]
ls forall a. [a] -> Int -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral (BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
- BlockHeight
sh)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BlockNode -> BlockHeight
nodeHeight BlockNode
sn forall a. Eq a => a -> a -> Bool
/= BlockHeight
sh) forall a b. (a -> b) -> a -> b
$
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"BUG: Node height not right in skip"
forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
sn
where
sh :: BlockHeight
sh = BlockHeight -> BlockHeight
skipHeight (BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
+ BlockHeight
1)
go :: BlockNode
-> [BlockNode]
-> BlockNode
-> BlockNode
-> [BlockNode]
-> [BlockHeader]
-> ExceptT String m [BlockNode]
go BlockNode
_ [BlockNode]
acc BlockNode
_ BlockNode
_ [BlockNode]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return [BlockNode]
acc
go BlockNode
lbh [BlockNode]
acc BlockNode
bb BlockNode
par [BlockNode]
pars (BlockHeader
h : [BlockHeader]
hs) = do
BlockNode
sk <- forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, BlockHeaders m, MonadError String (t m)) =>
BlockNode -> [BlockNode] -> BlockNode -> t m BlockNode
skipit BlockNode
lbh [BlockNode]
acc BlockNode
par
BlockNode
bn <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Network
-> BlockHeight
-> BlockNode
-> BlockNode
-> [BlockNode]
-> BlockHeader
-> BlockNode
-> Either String BlockNode
validBlock Network
net BlockHeight
t BlockNode
bb BlockNode
par [BlockNode]
pars BlockHeader
h BlockNode
sk
BlockNode
-> [BlockNode]
-> BlockNode
-> BlockNode
-> [BlockNode]
-> [BlockHeader]
-> ExceptT String m [BlockNode]
go BlockNode
lbh (BlockNode
bn forall a. a -> [a] -> [a]
: [BlockNode]
acc) (BlockNode -> BlockNode -> BlockNode
chooseBest BlockNode
bn BlockNode
bb) BlockNode
bn (forall a. Int -> [a] -> [a]
take Int
10 forall a b. (a -> b) -> a -> b
$ BlockNode
par forall a. a -> [a] -> [a]
: [BlockNode]
pars) [BlockHeader]
hs
parentBlock ::
BlockHeaders m =>
BlockHeader ->
m (Maybe BlockNode)
parentBlock :: forall (m :: * -> *).
BlockHeaders m =>
BlockHeader -> m (Maybe BlockNode)
parentBlock BlockHeader
bh = forall (m :: * -> *).
BlockHeaders m =>
BlockHash -> m (Maybe BlockNode)
getBlockHeader (BlockHeader -> BlockHash
prevBlock BlockHeader
bh)
connectBlock ::
BlockHeaders m =>
Network ->
Timestamp ->
BlockHeader ->
m (Either String BlockNode)
connectBlock :: forall (m :: * -> *).
BlockHeaders m =>
Network
-> BlockHeight -> BlockHeader -> m (Either String BlockNode)
connectBlock Network
net BlockHeight
t BlockHeader
bh =
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
BlockNode
par <-
forall (m :: * -> *) e a.
Functor m =>
e -> MaybeT m a -> ExceptT e m a
maybeToExceptT
String
"Could not get parent block"
(forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (m :: * -> *).
BlockHeaders m =>
BlockHeader -> m (Maybe BlockNode)
parentBlock BlockHeader
bh))
[BlockNode]
pars <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
Int -> BlockNode -> m [BlockNode]
getParents Int
10 BlockNode
par
Maybe BlockNode
skM <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor (BlockHeight -> BlockHeight
skipHeight (BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
+ BlockHeight
1)) BlockNode
par
BlockNode
sk <-
case Maybe BlockNode
skM of
Just BlockNode
sk -> forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
sk
Maybe BlockNode
Nothing ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
String
"BUG: Could not get skip for block "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (BlockHeader -> BlockHash
headerHash forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
par)
BlockNode
bb <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). BlockHeaders m => m BlockNode
getBestBlockHeader
BlockNode
bn <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Network
-> BlockHeight
-> BlockNode
-> BlockNode
-> [BlockNode]
-> BlockHeader
-> BlockNode
-> Either String BlockNode
validBlock Network
net BlockHeight
t BlockNode
bb BlockNode
par [BlockNode]
pars BlockHeader
bh BlockNode
sk
let bb' :: BlockNode
bb' = BlockNode -> BlockNode -> BlockNode
chooseBest BlockNode
bb BlockNode
bn
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). BlockHeaders m => BlockNode -> m ()
addBlockHeader BlockNode
bn
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BlockNode
bb forall a. Eq a => a -> a -> Bool
/= BlockNode
bb') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). BlockHeaders m => BlockNode -> m ()
setBestBlockHeader BlockNode
bb'
forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
bn
validBlock ::
Network ->
Timestamp ->
BlockNode ->
BlockNode ->
[BlockNode] ->
BlockHeader ->
BlockNode ->
Either String BlockNode
validBlock :: Network
-> BlockHeight
-> BlockNode
-> BlockNode
-> [BlockNode]
-> BlockHeader
-> BlockNode
-> Either String BlockNode
validBlock Network
net BlockHeight
t BlockNode
bb BlockNode
par [BlockNode]
pars BlockHeader
bh BlockNode
sk = do
let mt :: BlockHeight
mt = [BlockHeight] -> BlockHeight
medianTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (BlockHeader -> BlockHeight
blockTimestamp forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
nodeHeader) forall a b. (a -> b) -> a -> b
$ BlockNode
par forall a. a -> [a] -> [a]
: [BlockNode]
pars
nt :: BlockHeight
nt = BlockHeader -> BlockHeight
blockTimestamp BlockHeader
bh
hh :: BlockHash
hh = BlockHeader -> BlockHash
headerHash BlockHeader
bh
nv :: BlockHeight
nv = BlockHeader -> BlockHeight
blockVersion BlockHeader
bh
ng :: BlockHeight
ng = BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
+ BlockHeight
1
aw :: BlockWork
aw = BlockNode -> BlockWork
nodeWork BlockNode
par forall a. Num a => a -> a -> a
+ BlockHeader -> BlockWork
headerWork BlockHeader
bh
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Network -> BlockHeader -> Bool
isValidPOW Network
net BlockHeader
bh) forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Proof of work failed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (BlockHeader -> BlockHash
headerHash BlockHeader
bh)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BlockHeight
nt forall a. Ord a => a -> a -> Bool
<= BlockHeight
t forall a. Num a => a -> a -> a
+ BlockHeight
2 forall a. Num a => a -> a -> a
* BlockHeight
60 forall a. Num a => a -> a -> a
* BlockHeight
60) forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid header timestamp: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BlockHeight
nt
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BlockHeight
nt forall a. Ord a => a -> a -> Bool
>= BlockHeight
mt) forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Block timestamp too early: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BlockHeight
nt
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Network -> BlockHeight -> BlockHeight -> Bool
afterLastCP Network
net (BlockNode -> BlockHeight
nodeHeight BlockNode
bb) BlockHeight
ng) forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Rewriting pre-checkpoint chain: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BlockHeight
ng
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Network -> BlockHeight -> BlockHash -> Bool
validCP Network
net BlockHeight
ng BlockHash
hh) forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Rejected checkpoint: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BlockHeight
ng
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Network -> BlockHeight -> BlockHash -> Bool
bip34 Network
net BlockHeight
ng BlockHash
hh) forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Rejected BIP-34 block: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BlockHash
hh
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Network -> BlockHeight -> BlockHeight -> Bool
validVersion Network
net BlockHeight
ng BlockHeight
nv) forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid block version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BlockHeight
nv
forall (m :: * -> *) a. Monad m => a -> m a
return
BlockNode
{ nodeHeader :: BlockHeader
nodeHeader = BlockHeader
bh
, nodeHeight :: BlockHeight
nodeHeight = BlockHeight
ng
, nodeWork :: BlockWork
nodeWork = BlockWork
aw
, nodeSkip :: BlockHash
nodeSkip = BlockHeader -> BlockHash
headerHash forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
sk
}
medianTime :: [Timestamp] -> Timestamp
medianTime :: [BlockHeight] -> BlockHeight
medianTime [BlockHeight]
ts
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BlockHeight]
ts = forall a. HasCallStack => String -> a
error String
"Cannot compute median time of empty header list"
| Bool
otherwise = forall a. Ord a => [a] -> [a]
sort [BlockHeight]
ts forall a. [a] -> Int -> a
!! (forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockHeight]
ts forall a. Integral a => a -> a -> a
`div` Int
2)
skipHeight :: BlockHeight -> BlockHeight
skipHeight :: BlockHeight -> BlockHeight
skipHeight BlockHeight
height
| BlockHeight
height forall a. Ord a => a -> a -> Bool
< BlockHeight
2 = BlockHeight
0
| BlockHeight
height forall a. Bits a => a -> a -> a
.&. BlockHeight
1 forall a. Eq a => a -> a -> Bool
/= BlockHeight
0 = BlockHeight -> BlockHeight
invertLowestOne (BlockHeight -> BlockHeight
invertLowestOne forall a b. (a -> b) -> a -> b
$ BlockHeight
height forall a. Num a => a -> a -> a
- BlockHeight
1) forall a. Num a => a -> a -> a
+ BlockHeight
1
| Bool
otherwise = BlockHeight -> BlockHeight
invertLowestOne BlockHeight
height
invertLowestOne :: BlockHeight -> BlockHeight
invertLowestOne :: BlockHeight -> BlockHeight
invertLowestOne BlockHeight
height = BlockHeight
height forall a. Bits a => a -> a -> a
.&. (BlockHeight
height forall a. Num a => a -> a -> a
- BlockHeight
1)
getParents ::
BlockHeaders m =>
Int ->
BlockNode ->
m [BlockNode]
getParents :: forall (m :: * -> *).
BlockHeaders m =>
Int -> BlockNode -> m [BlockNode]
getParents = forall {t} {m :: * -> *}.
(Eq t, Num t, BlockHeaders m) =>
[BlockNode] -> t -> BlockNode -> m [BlockNode]
getpars []
where
getpars :: [BlockNode] -> t -> BlockNode -> m [BlockNode]
getpars [BlockNode]
acc t
0 BlockNode
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [BlockNode]
acc
getpars [BlockNode]
acc t
n BlockNode{BlockWork
BlockHeight
BlockHeader
BlockHash
nodeSkip :: BlockHash
nodeWork :: BlockWork
nodeHeight :: BlockHeight
nodeHeader :: BlockHeader
nodeSkip :: BlockNode -> BlockHash
nodeWork :: BlockNode -> BlockWork
nodeHeight :: BlockNode -> BlockHeight
nodeHeader :: BlockNode -> BlockHeader
..}
| BlockHeight
nodeHeight forall a. Eq a => a -> a -> Bool
== BlockHeight
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [BlockNode]
acc
| Bool
otherwise = do
Maybe BlockNode
parM <- forall (m :: * -> *).
BlockHeaders m =>
BlockHash -> m (Maybe BlockNode)
getBlockHeader forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHash
prevBlock BlockHeader
nodeHeader
case Maybe BlockNode
parM of
Just BlockNode
bn -> [BlockNode] -> t -> BlockNode -> m [BlockNode]
getpars (BlockNode
bn forall a. a -> [a] -> [a]
: [BlockNode]
acc) (t
n forall a. Num a => a -> a -> a
- t
1) BlockNode
bn
Maybe BlockNode
Nothing -> forall a. HasCallStack => String -> a
error String
"BUG: All non-genesis blocks should have a parent"
validCP ::
Network ->
BlockHeight ->
BlockHash ->
Bool
validCP :: Network -> BlockHeight -> BlockHash -> Bool
validCP Network
net BlockHeight
height BlockHash
newChildHash =
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup BlockHeight
height (Network -> [(BlockHeight, BlockHash)]
getCheckpoints Network
net) of
Just BlockHash
cpHash -> BlockHash
cpHash forall a. Eq a => a -> a -> Bool
== BlockHash
newChildHash
Maybe BlockHash
Nothing -> Bool
True
afterLastCP ::
Network ->
BlockHeight ->
BlockHeight ->
Bool
afterLastCP :: Network -> BlockHeight -> BlockHeight -> Bool
afterLastCP Network
net BlockHeight
bestHeight BlockHeight
newChildHeight =
case Maybe BlockHeight
lM of
Just BlockHeight
l -> BlockHeight
l forall a. Ord a => a -> a -> Bool
< BlockHeight
newChildHeight
Maybe BlockHeight
Nothing -> Bool
True
where
lM :: Maybe BlockHeight
lM =
forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
[BlockHeight
c | (BlockHeight
c, BlockHash
_) <- Network -> [(BlockHeight, BlockHash)]
getCheckpoints Network
net, BlockHeight
c forall a. Ord a => a -> a -> Bool
<= BlockHeight
bestHeight]
bip34 ::
Network ->
BlockHeight ->
BlockHash ->
Bool
bip34 :: Network -> BlockHeight -> BlockHash -> Bool
bip34 Network
net BlockHeight
height BlockHash
hsh
| forall a b. (a, b) -> a
fst (Network -> (BlockHeight, BlockHash)
getBip34Block Network
net) forall a. Eq a => a -> a -> Bool
== BlockHeight
0 = Bool
True
| forall a b. (a, b) -> a
fst (Network -> (BlockHeight, BlockHash)
getBip34Block Network
net) forall a. Eq a => a -> a -> Bool
== BlockHeight
height = forall a b. (a, b) -> b
snd (Network -> (BlockHeight, BlockHash)
getBip34Block Network
net) forall a. Eq a => a -> a -> Bool
== BlockHash
hsh
| Bool
otherwise = Bool
True
validVersion ::
Network ->
BlockHeight ->
Word32 ->
Bool
validVersion :: Network -> BlockHeight -> BlockHeight -> Bool
validVersion Network
net BlockHeight
height BlockHeight
version
| BlockHeight
version forall a. Ord a => a -> a -> Bool
< BlockHeight
2 = BlockHeight
height forall a. Ord a => a -> a -> Bool
< forall a b. (a, b) -> a
fst (Network -> (BlockHeight, BlockHash)
getBip34Block Network
net)
| BlockHeight
version forall a. Ord a => a -> a -> Bool
< BlockHeight
3 = BlockHeight
height forall a. Ord a => a -> a -> Bool
< Network -> BlockHeight
getBip66Height Network
net
| BlockHeight
version forall a. Ord a => a -> a -> Bool
< BlockHeight
4 = BlockHeight
height forall a. Ord a => a -> a -> Bool
< Network -> BlockHeight
getBip65Height Network
net
| Bool
otherwise = Bool
True
lastNoMinDiff :: BlockHeaders m => Network -> BlockNode -> m BlockNode
lastNoMinDiff :: forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> m BlockNode
lastNoMinDiff Network
_ bn :: BlockNode
bn@BlockNode{nodeHeight :: BlockNode -> BlockHeight
nodeHeight = BlockHeight
0} = forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
bn
lastNoMinDiff Network
net bn :: BlockNode
bn@BlockNode{BlockWork
BlockHeight
BlockHeader
BlockHash
nodeSkip :: BlockHash
nodeWork :: BlockWork
nodeHeight :: BlockHeight
nodeHeader :: BlockHeader
nodeSkip :: BlockNode -> BlockHash
nodeWork :: BlockNode -> BlockWork
nodeHeight :: BlockNode -> BlockHeight
nodeHeader :: BlockNode -> BlockHeader
..} = do
let i :: Bool
i = BlockHeight
nodeHeight forall a. Integral a => a -> a -> a
`mod` Network -> BlockHeight
diffInterval Network
net forall a. Eq a => a -> a -> Bool
/= BlockHeight
0
c :: BlockHeight
c = BlockWork -> BlockHeight
encodeCompact (Network -> BlockWork
getPowLimit Network
net)
l :: Bool
l = BlockHeader -> BlockHeight
blockBits BlockHeader
nodeHeader forall a. Eq a => a -> a -> Bool
== BlockHeight
c
e1 :: a
e1 =
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
String
"Could not get block header for parent of "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (BlockHeader -> BlockHash
headerHash BlockHeader
nodeHeader)
if Bool
i Bool -> Bool -> Bool
&& Bool
l
then do
BlockNode
bn' <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHash -> m (Maybe BlockNode)
getBlockHeader (BlockHeader -> BlockHash
prevBlock BlockHeader
nodeHeader)
forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> m BlockNode
lastNoMinDiff Network
net BlockNode
bn'
else forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
bn
nextWorkRequired ::
BlockHeaders m =>
Network ->
BlockNode ->
BlockHeader ->
m Word32
nextWorkRequired :: forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockHeader -> m BlockHeight
nextWorkRequired Network
net BlockNode
par BlockHeader
bh = do
Maybe BlockNode
ma <- forall (m :: * -> *).
BlockHeaders m =>
Network -> m (Maybe BlockNode)
getAsertAnchor Network
net
case forall {m :: * -> *} {m :: * -> *}.
(Alternative m, BlockHeaders m, Monad m) =>
m BlockNode -> m (BlockNode -> BlockHeader -> m BlockHeight)
asert Maybe BlockNode
ma forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (BlockNode -> BlockHeader -> m BlockHeight)
daa forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (BlockNode -> BlockHeader -> m BlockHeight)
eda forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (BlockNode -> BlockHeader -> m BlockHeight)
pow of
Just BlockNode -> BlockHeader -> m BlockHeight
f -> BlockNode -> BlockHeader -> m BlockHeight
f BlockNode
par BlockHeader
bh
Maybe (BlockNode -> BlockHeader -> m BlockHeight)
Nothing -> forall a. HasCallStack => String -> a
error String
"Could not determine difficulty algorithm"
where
asert :: m BlockNode -> m (BlockNode -> BlockHeader -> m BlockHeight)
asert m BlockNode
ma = do
BlockNode
anchor <- m BlockNode
ma
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Ord a => a -> a -> Bool
> BlockNode -> BlockHeight
nodeHeight BlockNode
anchor)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockNode -> BlockHeader -> m BlockHeight
nextAsertWorkRequired Network
net BlockNode
anchor
daa :: Maybe (BlockNode -> BlockHeader -> m BlockHeight)
daa = do
BlockHeight
daa_height <- Network -> Maybe BlockHeight
getDaaBlockHeight Network
net
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
+ BlockHeight
1 forall a. Ord a => a -> a -> Bool
>= BlockHeight
daa_height)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockHeader -> m BlockHeight
nextDaaWorkRequired Network
net
eda :: Maybe (BlockNode -> BlockHeader -> m BlockHeight)
eda = do
BlockHeight
eda_height <- Network -> Maybe BlockHeight
getEdaBlockHeight Network
net
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
+ BlockHeight
1 forall a. Ord a => a -> a -> Bool
>= BlockHeight
eda_height)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockHeader -> m BlockHeight
nextEdaWorkRequired Network
net
pow :: Maybe (BlockNode -> BlockHeader -> m BlockHeight)
pow = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockHeader -> m BlockHeight
nextPowWorkRequired Network
net
nextEdaWorkRequired ::
BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32
nextEdaWorkRequired :: forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockHeader -> m BlockHeight
nextEdaWorkRequired Network
net BlockNode
par BlockHeader
bh
| BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
+ BlockHeight
1 forall a. Integral a => a -> a -> a
`mod` Network -> BlockHeight
diffInterval Network
net forall a. Eq a => a -> a -> Bool
== BlockHeight
0 =
forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockHeader -> m BlockHeight
nextWorkRequired Network
net BlockNode
par BlockHeader
bh
| Bool
minDifficulty = forall (m :: * -> *) a. Monad m => a -> m a
return (BlockWork -> BlockHeight
encodeCompact (Network -> BlockWork
getPowLimit Network
net))
| BlockHeader -> BlockHeight
blockBits (BlockNode -> BlockHeader
nodeHeader BlockNode
par) forall a. Eq a => a -> a -> Bool
== BlockWork -> BlockHeight
encodeCompact (Network -> BlockWork
getPowLimit Network
net) =
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockWork -> BlockHeight
encodeCompact (Network -> BlockWork
getPowLimit Network
net))
| Bool
otherwise = do
BlockNode
par6 <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor (BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
- BlockHeight
6) BlockNode
par
[BlockNode]
pars <- forall (m :: * -> *).
BlockHeaders m =>
Int -> BlockNode -> m [BlockNode]
getParents Int
10 BlockNode
par
[BlockNode]
pars6 <- forall (m :: * -> *).
BlockHeaders m =>
Int -> BlockNode -> m [BlockNode]
getParents Int
10 BlockNode
par6
let par6med :: BlockHeight
par6med =
[BlockHeight] -> BlockHeight
medianTime forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (BlockHeader -> BlockHeight
blockTimestamp forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
nodeHeader) (BlockNode
par6 forall a. a -> [a] -> [a]
: [BlockNode]
pars6)
parmed :: BlockHeight
parmed = [BlockHeight] -> BlockHeight
medianTime forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (BlockHeader -> BlockHeight
blockTimestamp forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
nodeHeader) (BlockNode
par forall a. a -> [a] -> [a]
: [BlockNode]
pars)
mtp6 :: BlockHeight
mtp6 = BlockHeight
parmed forall a. Num a => a -> a -> a
- BlockHeight
par6med
if BlockHeight
mtp6 forall a. Ord a => a -> a -> Bool
< BlockHeight
12 forall a. Num a => a -> a -> a
* BlockHeight
3600
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHeight
blockBits (BlockNode -> BlockHeader
nodeHeader BlockNode
par)
else
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
let (BlockWork
diff, Bool
_) = BlockHeight -> (BlockWork, Bool)
decodeCompact (BlockHeader -> BlockHeight
blockBits (BlockNode -> BlockHeader
nodeHeader BlockNode
par))
ndiff :: BlockWork
ndiff = BlockWork
diff forall a. Num a => a -> a -> a
+ (BlockWork
diff forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
in if Network -> BlockWork
getPowLimit Network
net forall a. Ord a => a -> a -> Bool
> BlockWork
ndiff
then BlockWork -> BlockHeight
encodeCompact (Network -> BlockWork
getPowLimit Network
net)
else BlockWork -> BlockHeight
encodeCompact BlockWork
ndiff
where
minDifficulty :: Bool
minDifficulty =
BlockHeader -> BlockHeight
blockTimestamp BlockHeader
bh
forall a. Ord a => a -> a -> Bool
> BlockHeader -> BlockHeight
blockTimestamp (BlockNode -> BlockHeader
nodeHeader BlockNode
par) forall a. Num a => a -> a -> a
+ Network -> BlockHeight
getTargetSpacing Network
net forall a. Num a => a -> a -> a
* BlockHeight
2
e1 :: a
e1 = forall a. HasCallStack => String -> a
error String
"Could not get seventh ancestor of block"
nextDaaWorkRequired ::
BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32
nextDaaWorkRequired :: forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockHeader -> m BlockHeight
nextDaaWorkRequired Network
net BlockNode
par BlockHeader
bh
| Bool
minDifficulty = forall (m :: * -> *) a. Monad m => a -> m a
return (BlockWork -> BlockHeight
encodeCompact (Network -> BlockWork
getPowLimit Network
net))
| Bool
otherwise = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BlockHeight
height forall a. Ord a => a -> a -> Bool
>= Network -> BlockHeight
diffInterval Network
net) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> a
error String
"Block height below difficulty interval"
BlockNode
l <- forall (m :: * -> *). BlockHeaders m => BlockNode -> m BlockNode
getSuitableBlock BlockNode
par
BlockNode
par144 <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor (BlockHeight
height forall a. Num a => a -> a -> a
- BlockHeight
144) BlockNode
par
BlockNode
f <- forall (m :: * -> *). BlockHeaders m => BlockNode -> m BlockNode
getSuitableBlock BlockNode
par144
let nextTarget :: BlockWork
nextTarget = Network -> BlockNode -> BlockNode -> BlockWork
computeTarget Network
net BlockNode
f BlockNode
l
if BlockWork
nextTarget forall a. Ord a => a -> a -> Bool
> Network -> BlockWork
getPowLimit Network
net
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockWork -> BlockHeight
encodeCompact (Network -> BlockWork
getPowLimit Network
net)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockWork -> BlockHeight
encodeCompact BlockWork
nextTarget
where
height :: BlockHeight
height = BlockNode -> BlockHeight
nodeHeight BlockNode
par
e1 :: a
e1 = forall a. HasCallStack => String -> a
error String
"Cannot get ancestor at parent - 144 height"
minDifficulty :: Bool
minDifficulty =
BlockHeader -> BlockHeight
blockTimestamp BlockHeader
bh
forall a. Ord a => a -> a -> Bool
> BlockHeader -> BlockHeight
blockTimestamp (BlockNode -> BlockHeader
nodeHeader BlockNode
par) forall a. Num a => a -> a -> a
+ Network -> BlockHeight
getTargetSpacing Network
net forall a. Num a => a -> a -> a
* BlockHeight
2
mtp :: BlockHeaders m => BlockNode -> m Timestamp
mtp :: forall (m :: * -> *). BlockHeaders m => BlockNode -> m BlockHeight
mtp BlockNode
bn
| BlockNode -> BlockHeight
nodeHeight BlockNode
bn forall a. Eq a => a -> a -> Bool
== BlockHeight
0 = forall (m :: * -> *) a. Monad m => a -> m a
return BlockHeight
0
| Bool
otherwise = do
[BlockNode]
pars <- forall (m :: * -> *).
BlockHeaders m =>
Int -> BlockNode -> m [BlockNode]
getParents Int
11 BlockNode
bn
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [BlockHeight] -> BlockHeight
medianTime (forall a b. (a -> b) -> [a] -> [b]
map (BlockHeader -> BlockHeight
blockTimestamp forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
nodeHeader) [BlockNode]
pars)
firstGreaterOrEqual ::
BlockHeaders m =>
Network ->
(BlockNode -> m Ordering) ->
m (Maybe BlockNode)
firstGreaterOrEqual :: forall (m :: * -> *).
BlockHeaders m =>
Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
firstGreaterOrEqual = forall (m :: * -> *).
BlockHeaders m =>
Bool -> Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
binSearch Bool
False
lastSmallerOrEqual ::
BlockHeaders m =>
Network ->
(BlockNode -> m Ordering) ->
m (Maybe BlockNode)
lastSmallerOrEqual :: forall (m :: * -> *).
BlockHeaders m =>
Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
lastSmallerOrEqual = forall (m :: * -> *).
BlockHeaders m =>
Bool -> Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
binSearch Bool
True
binSearch ::
BlockHeaders m =>
Bool ->
Network ->
(BlockNode -> m Ordering) ->
m (Maybe BlockNode)
binSearch :: forall (m :: * -> *).
BlockHeaders m =>
Bool -> Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
binSearch Bool
top Network
net BlockNode -> m Ordering
f = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
(BlockNode
a, BlockNode
b) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
Network -> m (BlockNode, BlockNode)
extremes Network
net
forall {t :: (* -> *) -> * -> *}.
(MonadTrans t, MonadPlus (t m)) =>
BlockNode -> BlockNode -> t m BlockNode
go BlockNode
a BlockNode
b
where
go :: BlockNode -> BlockNode -> t m BlockNode
go BlockNode
a BlockNode
b = do
BlockNode
m <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
BlockHeaders m =>
BlockNode -> BlockNode -> m BlockNode
middleBlock BlockNode
a BlockNode
b
Ordering
a' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ BlockNode -> m Ordering
f BlockNode
a
Ordering
b' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ BlockNode -> m Ordering
f BlockNode
b
Ordering
m' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ BlockNode -> m Ordering
f BlockNode
m
(BlockNode, Ordering)
-> (BlockNode, Ordering) -> (BlockNode, Ordering) -> t m BlockNode
r (BlockNode
a, Ordering
a') (BlockNode
b, Ordering
b') (BlockNode
m, Ordering
m')
r :: (BlockNode, Ordering)
-> (BlockNode, Ordering) -> (BlockNode, Ordering) -> t m BlockNode
r (BlockNode
a, Ordering
a') (BlockNode
b, Ordering
b') (BlockNode
m, Ordering
m')
| Ordering -> Ordering -> Bool
out_of_bounds Ordering
a' Ordering
b' = forall (m :: * -> *) a. MonadPlus m => m a
mzero
| Ordering -> Bool
select_first Ordering
a' = forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
a
| Ordering -> Bool
select_last Ordering
b' = forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
b
| BlockNode -> BlockNode -> Bool
no_middle BlockNode
a BlockNode
b = forall {m :: * -> *} {a}. Monad m => a -> a -> m a
choose_one BlockNode
a BlockNode
b
| Ordering -> Ordering -> Bool
is_between Ordering
a' Ordering
m' = BlockNode -> BlockNode -> t m BlockNode
go BlockNode
a BlockNode
m
| Ordering -> Ordering -> Bool
is_between Ordering
m' Ordering
b' = BlockNode -> BlockNode -> t m BlockNode
go BlockNode
m BlockNode
b
| Bool
otherwise = forall (m :: * -> *) a. MonadPlus m => m a
mzero
select_first :: Ordering -> Bool
select_first Ordering
a'
| Bool -> Bool
not Bool
top = Ordering
a' forall a. Eq a => a -> a -> Bool
/= Ordering
LT
| Bool
otherwise = Bool
False
select_last :: Ordering -> Bool
select_last Ordering
b'
| Bool
top = Ordering
b' forall a. Eq a => a -> a -> Bool
/= Ordering
GT
| Bool
otherwise = Bool
False
out_of_bounds :: Ordering -> Ordering -> Bool
out_of_bounds Ordering
a' Ordering
b'
| Bool
top = Ordering
a' forall a. Eq a => a -> a -> Bool
== Ordering
GT
| Bool
otherwise = Ordering
b' forall a. Eq a => a -> a -> Bool
== Ordering
LT
no_middle :: BlockNode -> BlockNode -> Bool
no_middle BlockNode
a BlockNode
b = BlockNode -> BlockHeight
nodeHeight BlockNode
b forall a. Num a => a -> a -> a
- BlockNode -> BlockHeight
nodeHeight BlockNode
a forall a. Ord a => a -> a -> Bool
<= BlockHeight
1
is_between :: Ordering -> Ordering -> Bool
is_between Ordering
a' Ordering
b' = Ordering
a' forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Ordering
b' forall a. Eq a => a -> a -> Bool
/= Ordering
LT
choose_one :: a -> a -> m a
choose_one a
a a
b
| Bool
top = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return a
b
extremes :: BlockHeaders m => Network -> m (BlockNode, BlockNode)
extremes :: forall (m :: * -> *).
BlockHeaders m =>
Network -> m (BlockNode, BlockNode)
extremes Network
net = do
BlockNode
b <- forall (m :: * -> *). BlockHeaders m => m BlockNode
getBestBlockHeader
forall (m :: * -> *) a. Monad m => a -> m a
return (Network -> BlockNode
genesisNode Network
net, BlockNode
b)
middleBlock :: BlockHeaders m => BlockNode -> BlockNode -> m BlockNode
middleBlock :: forall (m :: * -> *).
BlockHeaders m =>
BlockNode -> BlockNode -> m BlockNode
middleBlock BlockNode
a BlockNode
b =
forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
h BlockNode
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe BlockNode
Nothing -> forall a. HasCallStack => String -> a
error String
"You fell into a pit full of mud and snakes"
Just BlockNode
x -> forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
x
where
h :: BlockHeight
h = forall a. Integral a => a -> a -> a
middleOf (BlockNode -> BlockHeight
nodeHeight BlockNode
a) (BlockNode -> BlockHeight
nodeHeight BlockNode
b)
middleOf :: Integral a => a -> a -> a
middleOf :: forall a. Integral a => a -> a -> a
middleOf a
a a
b = a
a forall a. Num a => a -> a -> a
+ ((a
b forall a. Num a => a -> a -> a
- a
a) forall a. Integral a => a -> a -> a
`div` a
2)
getAsertAnchor :: BlockHeaders m => Network -> m (Maybe BlockNode)
getAsertAnchor :: forall (m :: * -> *).
BlockHeaders m =>
Network -> m (Maybe BlockNode)
getAsertAnchor Network
net =
case Network -> Maybe BlockHeight
getAsertActivationTime Network
net of
Maybe BlockHeight
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just BlockHeight
act -> forall (m :: * -> *).
BlockHeaders m =>
Network -> (BlockNode -> m Ordering) -> m (Maybe BlockNode)
firstGreaterOrEqual Network
net (forall {m :: * -> *}.
BlockHeaders m =>
BlockHeight -> BlockNode -> m Ordering
f BlockHeight
act)
where
f :: BlockHeight -> BlockNode -> m Ordering
f BlockHeight
act BlockNode
bn = do
BlockHeight
m <- forall (m :: * -> *). BlockHeaders m => BlockNode -> m BlockHeight
mtp BlockNode
bn
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> Ordering
compare BlockHeight
m BlockHeight
act
nextAsertWorkRequired ::
BlockHeaders m =>
Network ->
BlockNode ->
BlockNode ->
BlockHeader ->
m Word32
nextAsertWorkRequired :: forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockNode -> BlockHeader -> m BlockHeight
nextAsertWorkRequired Network
net BlockNode
anchor BlockNode
par BlockHeader
bh = do
BlockNode
anchor_parent <-
forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e_fork
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHash -> m (Maybe BlockNode)
getBlockHeader (BlockHeader -> BlockHash
prevBlock (BlockNode -> BlockHeader
nodeHeader BlockNode
anchor))
let anchor_parent_time :: BlockWork
anchor_parent_time = forall a. Integral a => a -> BlockWork
toInteger forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHeight
blockTimestamp forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
anchor_parent
time_diff :: BlockWork
time_diff = BlockWork
current_time forall a. Num a => a -> a -> a
- BlockWork
anchor_parent_time
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockWork -> BlockHeight -> BlockWork -> BlockWork -> BlockHeight
computeAsertBits BlockWork
halflife BlockHeight
anchor_bits BlockWork
time_diff BlockWork
height_diff
where
halflife :: BlockWork
halflife = Network -> BlockWork
getAsertHalfLife Network
net
anchor_height :: BlockWork
anchor_height = forall a. Integral a => a -> BlockWork
toInteger forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeight
nodeHeight BlockNode
anchor
anchor_bits :: BlockHeight
anchor_bits = BlockHeader -> BlockHeight
blockBits forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
anchor
current_height :: BlockWork
current_height = forall a. Integral a => a -> BlockWork
toInteger (BlockNode -> BlockHeight
nodeHeight BlockNode
par) forall a. Num a => a -> a -> a
+ BlockWork
1
height_diff :: BlockWork
height_diff = BlockWork
current_height forall a. Num a => a -> a -> a
- BlockWork
anchor_height
current_time :: BlockWork
current_time = forall a. Integral a => a -> BlockWork
toInteger forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHeight
blockTimestamp BlockHeader
bh
e_fork :: a
e_fork = forall a. HasCallStack => String -> a
error String
"Could not get fork block header"
idealBlockTime :: Integer
idealBlockTime :: BlockWork
idealBlockTime = BlockWork
10 forall a. Num a => a -> a -> a
* BlockWork
60
rBits :: Int
rBits :: Int
rBits = Int
16
radix :: Integer
radix :: BlockWork
radix = BlockWork
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
rBits
maxBits :: Word32
maxBits :: BlockHeight
maxBits = BlockHeight
0x1d00ffff
maxTarget :: Integer
maxTarget :: BlockWork
maxTarget = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ BlockHeight -> (BlockWork, Bool)
decodeCompact BlockHeight
maxBits
computeAsertBits ::
Integer ->
Word32 ->
Integer ->
Integer ->
Word32
computeAsertBits :: BlockWork -> BlockHeight -> BlockWork -> BlockWork -> BlockHeight
computeAsertBits BlockWork
halflife BlockHeight
anchor_bits BlockWork
time_diff BlockWork
height_diff =
if BlockWork
e2 forall a. Ord a => a -> a -> Bool
>= BlockWork
0 Bool -> Bool -> Bool
&& BlockWork
e2 forall a. Ord a => a -> a -> Bool
< BlockWork
65536
then
if BlockWork
g4 forall a. Eq a => a -> a -> Bool
== BlockWork
0
then BlockWork -> BlockHeight
encodeCompact BlockWork
1
else
if BlockWork
g4 forall a. Ord a => a -> a -> Bool
> BlockWork
maxTarget
then BlockHeight
maxBits
else BlockWork -> BlockHeight
encodeCompact BlockWork
g4
else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Exponent not in range: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BlockWork
e2
where
g1 :: BlockWork
g1 = forall a b. (a, b) -> a
fst (BlockHeight -> (BlockWork, Bool)
decodeCompact BlockHeight
anchor_bits)
e1 :: BlockWork
e1 =
((BlockWork
time_diff forall a. Num a => a -> a -> a
- BlockWork
idealBlockTime forall a. Num a => a -> a -> a
* (BlockWork
height_diff forall a. Num a => a -> a -> a
+ BlockWork
1)) forall a. Num a => a -> a -> a
* BlockWork
radix)
forall a. Integral a => a -> a -> a
`quot` BlockWork
halflife
s :: BlockWork
s = BlockWork
e1 forall a. Bits a => a -> Int -> a
`shiftR` Int
rBits
e2 :: BlockWork
e2 = BlockWork
e1 forall a. Num a => a -> a -> a
- BlockWork
s forall a. Num a => a -> a -> a
* BlockWork
radix
g2 :: BlockWork
g2 =
BlockWork
g1
forall a. Num a => a -> a -> a
* ( BlockWork
radix
forall a. Num a => a -> a -> a
+ ( (BlockWork
195766423245049 forall a. Num a => a -> a -> a
* BlockWork
e2 forall a. Num a => a -> a -> a
+ BlockWork
971821376 forall a. Num a => a -> a -> a
* BlockWork
e2 forall a b. (Num a, Integral b) => a -> b -> a
^ BlockWork
2 forall a. Num a => a -> a -> a
+ BlockWork
5127 forall a. Num a => a -> a -> a
* BlockWork
e2 forall a b. (Num a, Integral b) => a -> b -> a
^ BlockWork
3 forall a. Num a => a -> a -> a
+ BlockWork
2 forall a b. (Num a, Integral b) => a -> b -> a
^ BlockWork
47)
forall a. Bits a => a -> Int -> a
`shiftR` (Int
rBits forall a. Num a => a -> a -> a
* Int
3)
)
)
g3 :: BlockWork
g3 =
if BlockWork
s forall a. Ord a => a -> a -> Bool
< BlockWork
0
then BlockWork
g2 forall a. Bits a => a -> Int -> a
`shiftR` forall a. Num a => a -> a
negate (forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockWork
s)
else BlockWork
g2 forall a. Bits a => a -> Int -> a
`shiftL` forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockWork
s
g4 :: BlockWork
g4 = BlockWork
g3 forall a. Bits a => a -> Int -> a
`shiftR` Int
rBits
computeTarget :: Network -> BlockNode -> BlockNode -> Integer
computeTarget :: Network -> BlockNode -> BlockNode -> BlockWork
computeTarget Network
net BlockNode
f BlockNode
l =
let work :: BlockWork
work = (BlockNode -> BlockWork
nodeWork BlockNode
l forall a. Num a => a -> a -> a
- BlockNode -> BlockWork
nodeWork BlockNode
f) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Network -> BlockHeight
getTargetSpacing Network
net)
actualTimespan :: BlockHeight
actualTimespan =
BlockHeader -> BlockHeight
blockTimestamp (BlockNode -> BlockHeader
nodeHeader BlockNode
l) forall a. Num a => a -> a -> a
- BlockHeader -> BlockHeight
blockTimestamp (BlockNode -> BlockHeader
nodeHeader BlockNode
f)
actualTimespan' :: BlockHeight
actualTimespan'
| BlockHeight
actualTimespan forall a. Ord a => a -> a -> Bool
> BlockHeight
288 forall a. Num a => a -> a -> a
* Network -> BlockHeight
getTargetSpacing Network
net =
BlockHeight
288 forall a. Num a => a -> a -> a
* Network -> BlockHeight
getTargetSpacing Network
net
| BlockHeight
actualTimespan forall a. Ord a => a -> a -> Bool
< BlockHeight
72 forall a. Num a => a -> a -> a
* Network -> BlockHeight
getTargetSpacing Network
net =
BlockHeight
72 forall a. Num a => a -> a -> a
* Network -> BlockHeight
getTargetSpacing Network
net
| Bool
otherwise = BlockHeight
actualTimespan
work' :: BlockWork
work' = BlockWork
work forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
actualTimespan'
in BlockWork
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (BlockWork
256 :: Integer) forall a. Integral a => a -> a -> a
`div` BlockWork
work'
getSuitableBlock :: BlockHeaders m => BlockNode -> m BlockNode
getSuitableBlock :: forall (m :: * -> *). BlockHeaders m => BlockNode -> m BlockNode
getSuitableBlock BlockNode
par = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Ord a => a -> a -> Bool
>= BlockHeight
3) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"Block height is less than three"
[BlockNode]
blocks <- (BlockNode
par forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
Int -> BlockNode -> m [BlockNode]
getParents Int
2 BlockNode
par
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BlockHeader -> BlockHeight
blockTimestamp forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
nodeHeader) [BlockNode]
blocks forall a. [a] -> Int -> a
!! Int
1
nextPowWorkRequired ::
BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32
nextPowWorkRequired :: forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> BlockHeader -> m BlockHeight
nextPowWorkRequired Network
net BlockNode
par BlockHeader
bh
| BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
+ BlockHeight
1 forall a. Integral a => a -> a -> a
`mod` Network -> BlockHeight
diffInterval Network
net forall a. Eq a => a -> a -> Bool
/= BlockHeight
0 =
if Network -> Bool
getAllowMinDifficultyBlocks Network
net
then
if BlockHeight
ht forall a. Ord a => a -> a -> Bool
> BlockHeight
pt forall a. Num a => a -> a -> a
+ BlockHeight
delta
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockWork -> BlockHeight
encodeCompact (Network -> BlockWork
getPowLimit Network
net)
else do
BlockNode
d <- forall (m :: * -> *).
BlockHeaders m =>
Network -> BlockNode -> m BlockNode
lastNoMinDiff Network
net BlockNode
par
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHeight
blockBits forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
d
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHeight
blockBits forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
par
| Bool
otherwise = do
let rh :: BlockHeight
rh = BlockNode -> BlockHeight
nodeHeight BlockNode
par forall a. Num a => a -> a -> a
- (Network -> BlockHeight
diffInterval Network
net forall a. Num a => a -> a -> a
- BlockHeight
1)
BlockNode
a <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
rh BlockNode
par
let t :: BlockHeight
t = BlockHeader -> BlockHeight
blockTimestamp forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Network -> BlockHeader -> BlockHeight -> BlockHeight
calcNextWork Network
net (BlockNode -> BlockHeader
nodeHeader BlockNode
par) BlockHeight
t
where
e1 :: a
e1 = forall a. HasCallStack => String -> a
error String
"Could not get ancestor for block header"
pt :: BlockHeight
pt = BlockHeader -> BlockHeight
blockTimestamp forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
par
ht :: BlockHeight
ht = BlockHeader -> BlockHeight
blockTimestamp BlockHeader
bh
delta :: BlockHeight
delta = Network -> BlockHeight
getTargetSpacing Network
net forall a. Num a => a -> a -> a
* BlockHeight
2
calcNextWork ::
Network ->
BlockHeader ->
Timestamp ->
Word32
calcNextWork :: Network -> BlockHeader -> BlockHeight -> BlockHeight
calcNextWork Network
net BlockHeader
header BlockHeight
time
| Network -> Bool
getPowNoRetargetting Network
net = BlockHeader -> BlockHeight
blockBits BlockHeader
header
| BlockWork
new forall a. Ord a => a -> a -> Bool
> Network -> BlockWork
getPowLimit Network
net = BlockWork -> BlockHeight
encodeCompact (Network -> BlockWork
getPowLimit Network
net)
| Bool
otherwise = BlockWork -> BlockHeight
encodeCompact BlockWork
new
where
s :: BlockHeight
s = BlockHeader -> BlockHeight
blockTimestamp BlockHeader
header forall a. Num a => a -> a -> a
- BlockHeight
time
n :: BlockHeight
n
| BlockHeight
s forall a. Ord a => a -> a -> Bool
< Network -> BlockHeight
getTargetTimespan Network
net forall a. Integral a => a -> a -> a
`div` BlockHeight
4 = Network -> BlockHeight
getTargetTimespan Network
net forall a. Integral a => a -> a -> a
`div` BlockHeight
4
| BlockHeight
s forall a. Ord a => a -> a -> Bool
> Network -> BlockHeight
getTargetTimespan Network
net forall a. Num a => a -> a -> a
* BlockHeight
4 = Network -> BlockHeight
getTargetTimespan Network
net forall a. Num a => a -> a -> a
* BlockHeight
4
| Bool
otherwise = BlockHeight
s
l :: BlockWork
l = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ BlockHeight -> (BlockWork, Bool)
decodeCompact forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHeight
blockBits BlockHeader
header
new :: BlockWork
new = BlockWork
l forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
n forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral (Network -> BlockHeight
getTargetTimespan Network
net)
isValidPOW :: Network -> BlockHeader -> Bool
isValidPOW :: Network -> BlockHeader -> Bool
isValidPOW Network
net BlockHeader
h
| BlockWork
target forall a. Ord a => a -> a -> Bool
<= BlockWork
0 Bool -> Bool -> Bool
|| Bool
over Bool -> Bool -> Bool
|| BlockWork
target forall a. Ord a => a -> a -> Bool
> Network -> BlockWork
getPowLimit Network
net = Bool
False
| Bool
otherwise = BlockHash -> BlockWork
blockPOW (BlockHeader -> BlockHash
headerHash BlockHeader
h) forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockWork
target
where
(BlockWork
target, Bool
over) = BlockHeight -> (BlockWork, Bool)
decodeCompact forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHeight
blockBits BlockHeader
h
blockPOW :: BlockHash -> Integer
blockPOW :: BlockHash -> BlockWork
blockPOW = ByteString -> BlockWork
bsToInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
headerWork :: BlockHeader -> Integer
BlockHeader
bh = BlockWork
largestHash forall a. Integral a => a -> a -> a
`div` (BlockWork
target forall a. Num a => a -> a -> a
+ BlockWork
1)
where
target :: BlockWork
target = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ BlockHeight -> (BlockWork, Bool)
decodeCompact forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHeight
blockBits BlockHeader
bh
largestHash :: BlockWork
largestHash = BlockWork
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
256
diffInterval :: Network -> Word32
diffInterval :: Network -> BlockHeight
diffInterval Network
net = Network -> BlockHeight
getTargetTimespan Network
net forall a. Integral a => a -> a -> a
`div` Network -> BlockHeight
getTargetSpacing Network
net
chooseBest :: BlockNode -> BlockNode -> BlockNode
chooseBest :: BlockNode -> BlockNode -> BlockNode
chooseBest BlockNode
b1 BlockNode
b2
| BlockNode -> BlockWork
nodeWork BlockNode
b1 forall a. Eq a => a -> a -> Bool
== BlockNode -> BlockWork
nodeWork BlockNode
b2 =
if BlockNode -> BlockHeight
nodeHeight BlockNode
b1 forall a. Ord a => a -> a -> Bool
>= BlockNode -> BlockHeight
nodeHeight BlockNode
b2
then BlockNode
b1
else BlockNode
b2
| BlockNode -> BlockWork
nodeWork BlockNode
b1 forall a. Ord a => a -> a -> Bool
> BlockNode -> BlockWork
nodeWork BlockNode
b2 = BlockNode
b1
| Bool
otherwise = BlockNode
b2
blockLocatorNodes :: BlockHeaders m => BlockNode -> m [BlockNode]
blockLocatorNodes :: forall (m :: * -> *). BlockHeaders m => BlockNode -> m [BlockNode]
blockLocatorNodes BlockNode
best =
forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}.
BlockHeaders m =>
[BlockNode] -> BlockNode -> BlockHeight -> m [BlockNode]
go [] BlockNode
best BlockHeight
1
where
e1 :: a
e1 = forall a. HasCallStack => String -> a
error String
"Could not get ancestor"
go :: [BlockNode] -> BlockNode -> BlockHeight -> m [BlockNode]
go [BlockNode]
loc BlockNode
bn BlockHeight
n =
let loc' :: [BlockNode]
loc' = BlockNode
bn forall a. a -> [a] -> [a]
: [BlockNode]
loc
n' :: BlockHeight
n' =
if forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockNode]
loc' forall a. Ord a => a -> a -> Bool
> Int
10
then BlockHeight
n forall a. Num a => a -> a -> a
* BlockHeight
2
else BlockHeight
1
in if BlockNode -> BlockHeight
nodeHeight BlockNode
bn forall a. Ord a => a -> a -> Bool
< BlockHeight
n'
then do
BlockNode
a <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
0 BlockNode
bn
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockNode
a forall a. a -> [a] -> [a]
: [BlockNode]
loc'
else do
let h :: BlockHeight
h = BlockNode -> BlockHeight
nodeHeight BlockNode
bn forall a. Num a => a -> a -> a
- BlockHeight
n'
BlockNode
bn' <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
h BlockNode
bn
[BlockNode] -> BlockNode -> BlockHeight -> m [BlockNode]
go [BlockNode]
loc' BlockNode
bn' BlockHeight
n'
blockLocator :: BlockHeaders m => BlockNode -> m BlockLocator
blockLocator :: forall (m :: * -> *). BlockHeaders m => BlockNode -> m BlockLocator
blockLocator BlockNode
bn = forall a b. (a -> b) -> [a] -> [b]
map (BlockHeader -> BlockHash
headerHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
nodeHeader) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). BlockHeaders m => BlockNode -> m [BlockNode]
blockLocatorNodes BlockNode
bn
mineBlock :: Network -> Word32 -> BlockHeader -> BlockHeader
mineBlock :: Network -> BlockHeight -> BlockHeader -> BlockHeader
mineBlock Network
net BlockHeight
seed BlockHeader
h =
forall a. [a] -> a
head
[ BlockHeader
j
| BlockHeight
i <- (forall a. Num a => a -> a -> a
+ BlockHeight
seed) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BlockHeight
0 .. forall a. Bounded a => a
maxBound]
, let j :: BlockHeader
j = BlockHeader
h{bhNonce :: BlockHeight
bhNonce = BlockHeight
i}
, Network -> BlockHeader -> Bool
isValidPOW Network
net BlockHeader
j
]
appendBlocks ::
Network ->
Word32 ->
BlockHeader ->
Int ->
[BlockHeader]
appendBlocks :: Network -> BlockHeight -> BlockHeader -> Int -> [BlockHeader]
appendBlocks Network
_ BlockHeight
_ BlockHeader
_ Int
0 = []
appendBlocks Network
net BlockHeight
seed BlockHeader
bh Int
i =
BlockHeader
bh' forall a. a -> [a] -> [a]
: Network -> BlockHeight -> BlockHeader -> Int -> [BlockHeader]
appendBlocks Network
net BlockHeight
seed BlockHeader
bh' (Int
i forall a. Num a => a -> a -> a
- Int
1)
where
bh' :: BlockHeader
bh' =
Network -> BlockHeight -> BlockHeader -> BlockHeader
mineBlock
Network
net
BlockHeight
seed
BlockHeader
bh
{ prevBlock :: BlockHash
prevBlock = BlockHeader -> BlockHash
headerHash BlockHeader
bh
,
merkleRoot :: Hash256
merkleRoot = forall b. ByteArrayAccess b => b -> Hash256
sha256 forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHeight
seed
}
splitPoint :: BlockHeaders m => BlockNode -> BlockNode -> m BlockNode
splitPoint :: forall (m :: * -> *).
BlockHeaders m =>
BlockNode -> BlockNode -> m BlockNode
splitPoint BlockNode
l BlockNode
r = do
let h :: BlockHeight
h = forall a. Ord a => a -> a -> a
min (BlockNode -> BlockHeight
nodeHeight BlockNode
l) (BlockNode -> BlockHeight
nodeHeight BlockNode
r)
BlockNode
ll <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
h BlockNode
l
BlockNode
lr <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
h BlockNode
r
forall (m :: * -> *).
BlockHeaders m =>
BlockNode -> BlockNode -> m BlockNode
f BlockNode
ll BlockNode
lr
where
e :: a
e = forall a. HasCallStack => String -> a
error String
"BUG: Could not get ancestor at lowest height"
f :: BlockNode -> BlockNode -> m BlockNode
f BlockNode
ll BlockNode
lr =
if BlockNode
ll forall a. Eq a => a -> a -> Bool
== BlockNode
lr
then forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
lr
else do
let h :: BlockHeight
h = BlockNode -> BlockHeight
nodeHeight BlockNode
ll forall a. Num a => a -> a -> a
- BlockHeight
1
BlockNode
pl <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
h BlockNode
ll
BlockNode
pr <- forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
BlockHeaders m =>
BlockHeight -> BlockNode -> m (Maybe BlockNode)
getAncestor BlockHeight
h BlockNode
lr
BlockNode -> BlockNode -> m BlockNode
f BlockNode
pl BlockNode
pr
genesisBlock :: Network -> Block
genesisBlock :: Network -> Block
genesisBlock Network
net = BlockHeader -> [Tx] -> Block
Block (Network -> BlockHeader
getGenesisHeader Network
net) [Tx
genesisTx]
computeSubsidy :: Network -> BlockHeight -> Word64
computeSubsidy :: Network -> BlockHeight -> Word64
computeSubsidy Network
net BlockHeight
height =
let halvings :: BlockHeight
halvings = BlockHeight
height forall a. Integral a => a -> a -> a
`div` Network -> BlockHeight
getHalvingInterval Network
net
ini :: Word64
ini = Word64
50 forall a. Num a => a -> a -> a
* Word64
100 forall a. Num a => a -> a -> a
* Word64
1000 forall a. Num a => a -> a -> a
* Word64
1000
in if BlockHeight
halvings forall a. Ord a => a -> a -> Bool
>= BlockHeight
64
then Word64
0
else Word64
ini forall a. Bits a => a -> Int -> a
`shiftR` forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
halvings