{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- Module      : Haskoin.Block.Common
-- Copyright   : No rights reserved
-- License     : MIT
-- Maintainer  : jprupp@protonmail.ch
-- Stability   : experimental
-- Portability : POSIX
--
-- Common data types and functions to handle blocks from the block chain.
module Haskoin.Block.Common
  ( -- * Blocks
    Block (..),
    BlockHeight,
    Timestamp,
    BlockHeader (..),
    headerHash,
    BlockLocator,
    GetBlocks (..),
    GetHeaders (..),
    BlockHeaderCount,
    BlockHash (..),
    blockHashToHex,
    hexToBlockHash,
    Headers (..),
    decodeCompact,
    encodeCompact,
  )
where

import Control.DeepSeq
import Control.Monad
import Data.Aeson
import Data.Aeson.Encoding
import Data.Binary (Binary (..))
import Data.Bits
import Data.ByteString qualified as B
import Data.ByteString.Builder (char7)
import Data.ByteString.Lazy qualified as L
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Hashable
import Data.Maybe
import Data.Serialize (Serialize (..))
import Data.String
import Data.String.Conversions
import Data.Text (Text)
import Data.Word
import GHC.Generics
import Haskoin.Crypto.Hash
import Haskoin.Network.Common
import Haskoin.Transaction.Common
import Haskoin.Util.Helpers
import Text.Read qualified as R

-- | Height of a block in the block chain, starting at 0 for Genesis.
type BlockHeight = Word32

-- | Block timestamp as Unix time (seconds since 1970-01-01 00:00 UTC).
type Timestamp = Word32

-- | Block header and transactions.
data Block = Block
  { Block -> BlockHeader
header :: !BlockHeader,
    Block -> [Tx]
txs :: ![Tx]
  }
  deriving (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
/= :: Block -> Block -> Bool
Eq, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show, ReadPrec [Block]
ReadPrec Block
Int -> ReadS Block
ReadS [Block]
(Int -> ReadS Block)
-> ReadS [Block]
-> ReadPrec Block
-> ReadPrec [Block]
-> Read Block
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Block
readsPrec :: Int -> ReadS Block
$creadList :: ReadS [Block]
readList :: ReadS [Block]
$creadPrec :: ReadPrec Block
readPrec :: ReadPrec Block
$creadListPrec :: ReadPrec [Block]
readListPrec :: ReadPrec [Block]
Read, (forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Block -> Rep Block x
from :: forall x. Block -> Rep Block x
$cto :: forall x. Rep Block x -> Block
to :: forall x. Rep Block x -> Block
Generic, Eq Block
Eq Block =>
(Int -> Block -> Int) -> (Block -> Int) -> Hashable Block
Int -> Block -> Int
Block -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Block -> Int
hashWithSalt :: Int -> Block -> Int
$chash :: Block -> Int
hash :: Block -> Int
Hashable, Block -> ()
(Block -> ()) -> NFData Block
forall a. (a -> ()) -> NFData a
$crnf :: Block -> ()
rnf :: Block -> ()
NFData)

instance Serial Block where
  deserialize :: forall (m :: * -> *). MonadGet m => m Block
deserialize = do
    BlockHeader
header <- m BlockHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHeader
deserialize
    (VarInt Word64
c) <- m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarInt
deserialize
    [Tx]
txs <- Int -> m Tx -> m [Tx]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m Tx
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Tx
deserialize
    Block -> m Block
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> m Block) -> Block -> m Block
forall a b. (a -> b) -> a -> b
$ BlockHeader -> [Tx] -> Block
Block BlockHeader
header [Tx]
txs
  serialize :: forall (m :: * -> *). MonadPut m => Block -> m ()
serialize (Block BlockHeader
h [Tx]
txs) = do
    BlockHeader -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHeader -> m ()
serialize BlockHeader
h
    Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [Tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
txs
    [Tx] -> (Tx -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Tx]
txs Tx -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
serialize

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

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

instance ToJSON Block where
  toJSON :: Block -> Value
toJSON (Block BlockHeader
h [Tx]
t) =
    [Pair] -> Value
object [Key
"header" Key -> BlockHeader -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockHeader
h, Key
"transactions" Key -> [Tx] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Tx]
t]
  toEncoding :: Block -> Encoding
toEncoding (Block BlockHeader
h [Tx]
t) =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"header" Key -> Encoding -> Series
`pair` BlockHeader -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BlockHeader
h,
          Key
"transactions" Key -> Encoding -> Series
`pair` (Tx -> Encoding) -> [Tx] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Tx -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [Tx]
t
        ]

instance FromJSON Block where
  parseJSON :: Value -> Parser Block
parseJSON =
    String -> (Object -> Parser Block) -> Value -> Parser Block
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Block" ((Object -> Parser Block) -> Value -> Parser Block)
-> (Object -> Parser Block) -> Value -> Parser Block
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      BlockHeader -> [Tx] -> Block
Block (BlockHeader -> [Tx] -> Block)
-> Parser BlockHeader -> Parser ([Tx] -> Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser BlockHeader
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"header" Parser ([Tx] -> Block) -> Parser [Tx] -> Parser Block
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Tx]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transactions"

-- | Block header hash. To be serialized reversed for display purposes.
newtype BlockHash = BlockHash {BlockHash -> Hash256
get :: Hash256}
  deriving (BlockHash -> BlockHash -> Bool
(BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool) -> Eq BlockHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockHash -> BlockHash -> Bool
== :: BlockHash -> BlockHash -> Bool
$c/= :: BlockHash -> BlockHash -> Bool
/= :: BlockHash -> BlockHash -> Bool
Eq, Eq BlockHash
Eq BlockHash =>
(BlockHash -> BlockHash -> Ordering)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> Bool)
-> (BlockHash -> BlockHash -> BlockHash)
-> (BlockHash -> BlockHash -> BlockHash)
-> Ord BlockHash
BlockHash -> BlockHash -> Bool
BlockHash -> BlockHash -> Ordering
BlockHash -> BlockHash -> BlockHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockHash -> BlockHash -> Ordering
compare :: BlockHash -> BlockHash -> Ordering
$c< :: BlockHash -> BlockHash -> Bool
< :: BlockHash -> BlockHash -> Bool
$c<= :: BlockHash -> BlockHash -> Bool
<= :: BlockHash -> BlockHash -> Bool
$c> :: BlockHash -> BlockHash -> Bool
> :: BlockHash -> BlockHash -> Bool
$c>= :: BlockHash -> BlockHash -> Bool
>= :: BlockHash -> BlockHash -> Bool
$cmax :: BlockHash -> BlockHash -> BlockHash
max :: BlockHash -> BlockHash -> BlockHash
$cmin :: BlockHash -> BlockHash -> BlockHash
min :: BlockHash -> BlockHash -> BlockHash
Ord, (forall x. BlockHash -> Rep BlockHash x)
-> (forall x. Rep BlockHash x -> BlockHash) -> Generic BlockHash
forall x. Rep BlockHash x -> BlockHash
forall x. BlockHash -> Rep BlockHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockHash -> Rep BlockHash x
from :: forall x. BlockHash -> Rep BlockHash x
$cto :: forall x. Rep BlockHash x -> BlockHash
to :: forall x. Rep BlockHash x -> BlockHash
Generic, Eq BlockHash
Eq BlockHash =>
(Int -> BlockHash -> Int)
-> (BlockHash -> Int) -> Hashable BlockHash
Int -> BlockHash -> Int
BlockHash -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BlockHash -> Int
hashWithSalt :: Int -> BlockHash -> Int
$chash :: BlockHash -> Int
hash :: BlockHash -> Int
Hashable, (forall (m :: * -> *). MonadPut m => BlockHash -> m ())
-> (forall (m :: * -> *). MonadGet m => m BlockHash)
-> Serial BlockHash
forall a.
(forall (m :: * -> *). MonadPut m => a -> m ())
-> (forall (m :: * -> *). MonadGet m => m a) -> Serial a
forall (m :: * -> *). MonadGet m => m BlockHash
forall (m :: * -> *). MonadPut m => BlockHash -> m ()
$cserialize :: forall (m :: * -> *). MonadPut m => BlockHash -> m ()
serialize :: forall (m :: * -> *). MonadPut m => BlockHash -> m ()
$cdeserialize :: forall (m :: * -> *). MonadGet m => m BlockHash
deserialize :: forall (m :: * -> *). MonadGet m => m BlockHash
Serial, BlockHash -> ()
(BlockHash -> ()) -> NFData BlockHash
forall a. (a -> ()) -> NFData a
$crnf :: BlockHash -> ()
rnf :: BlockHash -> ()
NFData)

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

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

instance Show BlockHash where
  showsPrec :: Int -> BlockHash -> ShowS
showsPrec Int
_ = Text -> ShowS
forall a. Show a => a -> ShowS
shows (Text -> ShowS) -> (BlockHash -> Text) -> BlockHash -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> Text
blockHashToHex

instance Read BlockHash where
  readPrec :: ReadPrec BlockHash
readPrec = do
    R.String String
str <- ReadPrec Lexeme
R.lexP
    ReadPrec BlockHash
-> (BlockHash -> ReadPrec BlockHash)
-> Maybe BlockHash
-> ReadPrec BlockHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec BlockHash
forall a. ReadPrec a
R.pfail BlockHash -> ReadPrec BlockHash
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BlockHash -> ReadPrec BlockHash)
-> Maybe BlockHash -> ReadPrec BlockHash
forall a b. (a -> b) -> a -> b
$ Text -> Maybe BlockHash
hexToBlockHash (Text -> Maybe BlockHash) -> Text -> Maybe BlockHash
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
str

instance IsString BlockHash where
  fromString :: String -> BlockHash
fromString String
s =
    BlockHash -> Maybe BlockHash -> BlockHash
forall a. a -> Maybe a -> a
fromMaybe (String -> BlockHash
forall a. HasCallStack => String -> a
error String
"Could not read block hash from hex string") (Maybe BlockHash -> BlockHash) -> Maybe BlockHash -> BlockHash
forall a b. (a -> b) -> a -> b
$
      Text -> Maybe BlockHash
hexToBlockHash (Text -> Maybe BlockHash) -> Text -> Maybe BlockHash
forall a b. (a -> b) -> a -> b
$
        String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
s

instance FromJSON BlockHash where
  parseJSON :: Value -> Parser BlockHash
parseJSON =
    String -> (Text -> Parser BlockHash) -> Value -> Parser BlockHash
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"BlockHash" ((Text -> Parser BlockHash) -> Value -> Parser BlockHash)
-> (Text -> Parser BlockHash) -> Value -> Parser BlockHash
forall a b. (a -> b) -> a -> b
$
      Parser BlockHash
-> (BlockHash -> Parser BlockHash)
-> Maybe BlockHash
-> Parser BlockHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser BlockHash
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero BlockHash -> Parser BlockHash
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BlockHash -> Parser BlockHash)
-> (Text -> Maybe BlockHash) -> Text -> Parser BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe BlockHash
hexToBlockHash

instance ToJSON BlockHash where
  toJSON :: BlockHash -> Value
toJSON = Text -> Value
String (Text -> Value) -> (BlockHash -> Text) -> BlockHash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> Text
blockHashToHex
  toEncoding :: BlockHash -> Encoding
toEncoding = ByteString -> Encoding
hexEncoding (ByteString -> Encoding)
-> (BlockHash -> ByteString) -> BlockHash -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (BlockHash -> ByteString) -> BlockHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString)
-> (BlockHash -> Put) -> BlockHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHash -> m ()
serialize

-- | Block hashes are reversed with respect to the in-memory byte order in a
-- block hash when displayed.
blockHashToHex :: BlockHash -> Text
blockHashToHex :: BlockHash -> Text
blockHashToHex (BlockHash Hash256
h) = ByteString -> Text
encodeHex (ByteString -> ByteString
B.reverse (Put -> ByteString
runPutS (Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize Hash256
h)))

-- | Convert a human-readable hex block hash into a 'BlockHash'. Bytes are
-- reversed as normal.
hexToBlockHash :: Text -> Maybe BlockHash
hexToBlockHash :: Text -> Maybe BlockHash
hexToBlockHash Text
hex = do
  ByteString
bs <- ByteString -> ByteString
B.reverse (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe ByteString
decodeHex Text
hex
  Hash256
h <- Either String Hash256 -> Maybe Hash256
forall a b. Either a b -> Maybe b
eitherToMaybe (Get Hash256 -> ByteString -> Either String Hash256
forall a. Get a -> ByteString -> Either String a
runGetS Get Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash256
deserialize ByteString
bs)
  BlockHash -> Maybe BlockHash
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockHash -> Maybe BlockHash) -> BlockHash -> Maybe BlockHash
forall a b. (a -> b) -> a -> b
$ Hash256 -> BlockHash
BlockHash Hash256
h

-- | Data type recording information of a 'Block'. The hash of a block is
-- defined as the hash of this data structure, serialized. The block mining
-- process involves finding a partial hash collision by varying the nonce in the
-- 'BlockHeader' and/or additional entropy in the coinbase 'Transaction' of this
-- 'Block'. Variations in the coinbase will result in different merkle roots in
-- the 'BlockHeader'.
data BlockHeader = BlockHeader
  { BlockHeader -> Word32
version :: !Word32, --  4 bytes

    -- | hash of the previous block (parent)
    BlockHeader -> BlockHash
prev :: !BlockHash, -- 32 bytes

    -- | root of the merkle tree of transactions
    BlockHeader -> Hash256
merkle :: !Hash256, -- 32 bytes

    -- | unix timestamp
    BlockHeader -> Word32
timestamp :: !Timestamp, --  4 bytes

    -- | difficulty target
    BlockHeader -> Word32
bits :: !Word32, --  4 bytes

    -- | random nonce
    BlockHeader -> Word32
nonce :: !Word32 --  4 bytes
  }
  deriving (BlockHeader -> BlockHeader -> Bool
(BlockHeader -> BlockHeader -> Bool)
-> (BlockHeader -> BlockHeader -> Bool) -> Eq BlockHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockHeader -> BlockHeader -> Bool
== :: BlockHeader -> BlockHeader -> Bool
$c/= :: BlockHeader -> BlockHeader -> Bool
/= :: BlockHeader -> BlockHeader -> Bool
Eq, Eq BlockHeader
Eq BlockHeader =>
(BlockHeader -> BlockHeader -> Ordering)
-> (BlockHeader -> BlockHeader -> Bool)
-> (BlockHeader -> BlockHeader -> Bool)
-> (BlockHeader -> BlockHeader -> Bool)
-> (BlockHeader -> BlockHeader -> Bool)
-> (BlockHeader -> BlockHeader -> BlockHeader)
-> (BlockHeader -> BlockHeader -> BlockHeader)
-> Ord BlockHeader
BlockHeader -> BlockHeader -> Bool
BlockHeader -> BlockHeader -> Ordering
BlockHeader -> BlockHeader -> BlockHeader
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockHeader -> BlockHeader -> Ordering
compare :: BlockHeader -> BlockHeader -> Ordering
$c< :: BlockHeader -> BlockHeader -> Bool
< :: BlockHeader -> BlockHeader -> Bool
$c<= :: BlockHeader -> BlockHeader -> Bool
<= :: BlockHeader -> BlockHeader -> Bool
$c> :: BlockHeader -> BlockHeader -> Bool
> :: BlockHeader -> BlockHeader -> Bool
$c>= :: BlockHeader -> BlockHeader -> Bool
>= :: BlockHeader -> BlockHeader -> Bool
$cmax :: BlockHeader -> BlockHeader -> BlockHeader
max :: BlockHeader -> BlockHeader -> BlockHeader
$cmin :: BlockHeader -> BlockHeader -> BlockHeader
min :: BlockHeader -> BlockHeader -> BlockHeader
Ord, Int -> BlockHeader -> ShowS
[BlockHeader] -> ShowS
BlockHeader -> String
(Int -> BlockHeader -> ShowS)
-> (BlockHeader -> String)
-> ([BlockHeader] -> ShowS)
-> Show BlockHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockHeader -> ShowS
showsPrec :: Int -> BlockHeader -> ShowS
$cshow :: BlockHeader -> String
show :: BlockHeader -> String
$cshowList :: [BlockHeader] -> ShowS
showList :: [BlockHeader] -> ShowS
Show, ReadPrec [BlockHeader]
ReadPrec BlockHeader
Int -> ReadS BlockHeader
ReadS [BlockHeader]
(Int -> ReadS BlockHeader)
-> ReadS [BlockHeader]
-> ReadPrec BlockHeader
-> ReadPrec [BlockHeader]
-> Read BlockHeader
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BlockHeader
readsPrec :: Int -> ReadS BlockHeader
$creadList :: ReadS [BlockHeader]
readList :: ReadS [BlockHeader]
$creadPrec :: ReadPrec BlockHeader
readPrec :: ReadPrec BlockHeader
$creadListPrec :: ReadPrec [BlockHeader]
readListPrec :: ReadPrec [BlockHeader]
Read, (forall x. BlockHeader -> Rep BlockHeader x)
-> (forall x. Rep BlockHeader x -> BlockHeader)
-> Generic BlockHeader
forall x. Rep BlockHeader x -> BlockHeader
forall x. BlockHeader -> Rep BlockHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockHeader -> Rep BlockHeader x
from :: forall x. BlockHeader -> Rep BlockHeader x
$cto :: forall x. Rep BlockHeader x -> BlockHeader
to :: forall x. Rep BlockHeader x -> BlockHeader
Generic, Eq BlockHeader
Eq BlockHeader =>
(Int -> BlockHeader -> Int)
-> (BlockHeader -> Int) -> Hashable BlockHeader
Int -> BlockHeader -> Int
BlockHeader -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BlockHeader -> Int
hashWithSalt :: Int -> BlockHeader -> Int
$chash :: BlockHeader -> Int
hash :: BlockHeader -> Int
Hashable, BlockHeader -> ()
(BlockHeader -> ()) -> NFData BlockHeader
forall a. (a -> ()) -> NFData a
$crnf :: BlockHeader -> ()
rnf :: BlockHeader -> ()
NFData)

-- 80 bytes

instance ToJSON BlockHeader where
  toJSON :: BlockHeader -> Value
toJSON (BlockHeader Word32
v BlockHash
p Hash256
m Word32
t Word32
b Word32
n) =
    [Pair] -> Value
object
      [ Key
"version" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
v,
        Key
"prevblock" Key -> BlockHash -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockHash
p,
        Key
"merkleroot" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
encodeHex (Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize Hash256
m),
        Key
"timestamp" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
t,
        Key
"bits" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
b,
        Key
"nonce" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
n
      ]
  toEncoding :: BlockHeader -> Encoding
toEncoding (BlockHeader Word32
v BlockHash
p Hash256
m Word32
t Word32
b Word32
n) =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"version" Key -> Encoding -> Series
`pair` Word32 -> Encoding
word32 Word32
v,
          Key
"prevblock" Key -> Encoding -> Series
`pair` BlockHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BlockHash
p,
          Key
"merkleroot" Key -> Encoding -> Series
`pair` ByteString -> Encoding
hexEncoding (Put -> ByteString
runPutL (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize Hash256
m),
          Key
"timestamp" Key -> Encoding -> Series
`pair` Word32 -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Word32
t,
          Key
"bits" Key -> Encoding -> Series
`pair` Word32 -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Word32
b,
          Key
"nonce" Key -> Encoding -> Series
`pair` Word32 -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Word32
n
        ]

instance FromJSON BlockHeader where
  parseJSON :: Value -> Parser BlockHeader
parseJSON =
    String
-> (Object -> Parser BlockHeader) -> Value -> Parser BlockHeader
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BlockHeader" ((Object -> Parser BlockHeader) -> Value -> Parser BlockHeader)
-> (Object -> Parser BlockHeader) -> Value -> Parser BlockHeader
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Word32
-> BlockHash
-> Hash256
-> Word32
-> Word32
-> Word32
-> BlockHeader
BlockHeader
        (Word32
 -> BlockHash
 -> Hash256
 -> Word32
 -> Word32
 -> Word32
 -> BlockHeader)
-> Parser Word32
-> Parser
     (BlockHash -> Hash256 -> Word32 -> Word32 -> Word32 -> BlockHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
        Parser
  (BlockHash -> Hash256 -> Word32 -> Word32 -> Word32 -> BlockHeader)
-> Parser BlockHash
-> Parser (Hash256 -> Word32 -> Word32 -> Word32 -> BlockHeader)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser BlockHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prevblock"
        Parser (Hash256 -> Word32 -> Word32 -> Word32 -> BlockHeader)
-> Parser Hash256
-> Parser (Word32 -> Word32 -> Word32 -> BlockHeader)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Hash256
f (Text -> Parser Hash256) -> Parser Text -> Parser Hash256
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"merkleroot")
        Parser (Word32 -> Word32 -> Word32 -> BlockHeader)
-> Parser Word32 -> Parser (Word32 -> Word32 -> BlockHeader)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp"
        Parser (Word32 -> Word32 -> BlockHeader)
-> Parser Word32 -> Parser (Word32 -> BlockHeader)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bits"
        Parser (Word32 -> BlockHeader)
-> Parser Word32 -> Parser BlockHeader
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nonce"
    where
      f :: Text -> Parser Hash256
f = Parser Hash256
-> (Hash256 -> Parser Hash256) -> Maybe Hash256 -> Parser Hash256
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser Hash256
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero Hash256 -> Parser Hash256
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Hash256 -> Parser Hash256)
-> (Text -> Maybe Hash256) -> Text -> Parser Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String Hash256 -> Maybe Hash256
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String Hash256 -> Maybe Hash256)
-> (ByteString -> Either String Hash256)
-> ByteString
-> Maybe Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get Hash256 -> ByteString -> Either String Hash256
forall a. Get a -> ByteString -> Either String a
runGetS Get Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash256
deserialize (ByteString -> Maybe Hash256)
-> (Text -> Maybe ByteString) -> Text -> Maybe Hash256
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeHex)

instance Serial BlockHeader where
  deserialize :: forall (m :: * -> *). MonadGet m => m BlockHeader
deserialize = do
    Word32
v <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
    BlockHash
p <- m BlockHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHash
deserialize
    Hash256
m <- m Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash256
deserialize
    Word32
t <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
    Word32
b <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
    Word32
n <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
    BlockHeader -> m BlockHeader
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
      BlockHeader
        { $sel:version:BlockHeader :: Word32
version = Word32
v,
          $sel:prev:BlockHeader :: BlockHash
prev = BlockHash
p,
          $sel:merkle:BlockHeader :: Hash256
merkle = Hash256
m,
          $sel:timestamp:BlockHeader :: Word32
timestamp = Word32
t,
          $sel:bits:BlockHeader :: Word32
bits = Word32
b,
          $sel:nonce:BlockHeader :: Word32
nonce = Word32
n
        }
  serialize :: forall (m :: * -> *). MonadPut m => BlockHeader -> m ()
serialize (BlockHeader Word32
v BlockHash
p Hash256
m Word32
bt Word32
bb Word32
n) = do
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
v
    BlockHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHash -> m ()
serialize BlockHash
p
    Hash256 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize Hash256
m
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
bt
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
bb
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
n

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

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

-- | Compute hash of 'BlockHeader'.
headerHash :: BlockHeader -> BlockHash
headerHash :: BlockHeader -> BlockHash
headerHash = Hash256 -> BlockHash
BlockHash (Hash256 -> BlockHash)
-> (BlockHeader -> Hash256) -> BlockHeader -> BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 (ByteString -> Hash256)
-> (BlockHeader -> ByteString) -> BlockHeader -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString)
-> Putter BlockHeader -> BlockHeader -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter BlockHeader
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHeader -> m ()
serialize

-- | A block locator is a set of block headers, denser towards the best block
-- and sparser towards the genesis block. It starts at the highest block known.
-- It is used by a node to synchronize against the network. When the locator is
-- provided to a peer, it will send back block hashes starting from the first
-- block in the locator that it recognizes.
type BlockLocator = [BlockHash]

-- | Data type representing a getblocks message request. It is used in the
-- bitcoin protocol to retrieve blocks from a peer by providing it a
-- 'BlockLocator' object. The response to a 'GetBlocks' message is an 'Inv'
-- message containing a list of block hashes that the peer believes this node is
-- missing. The number of block hashes in that inv message will end at the stop
-- block hash, at at the tip of the chain, or after 500 entries, whichever comes
-- earlier.
data GetBlocks = GetBlocks
  { GetBlocks -> Word32
version :: !Word32,
    -- | block locator object
    GetBlocks -> [BlockHash]
locator :: !BlockLocator,
    -- | hash of the last desired block
    GetBlocks -> BlockHash
stop :: !BlockHash
  }
  deriving (GetBlocks -> GetBlocks -> Bool
(GetBlocks -> GetBlocks -> Bool)
-> (GetBlocks -> GetBlocks -> Bool) -> Eq GetBlocks
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetBlocks -> GetBlocks -> Bool
== :: GetBlocks -> GetBlocks -> Bool
$c/= :: GetBlocks -> GetBlocks -> Bool
/= :: GetBlocks -> GetBlocks -> Bool
Eq, Int -> GetBlocks -> ShowS
[GetBlocks] -> ShowS
GetBlocks -> String
(Int -> GetBlocks -> ShowS)
-> (GetBlocks -> String)
-> ([GetBlocks] -> ShowS)
-> Show GetBlocks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetBlocks -> ShowS
showsPrec :: Int -> GetBlocks -> ShowS
$cshow :: GetBlocks -> String
show :: GetBlocks -> String
$cshowList :: [GetBlocks] -> ShowS
showList :: [GetBlocks] -> ShowS
Show, ReadPrec [GetBlocks]
ReadPrec GetBlocks
Int -> ReadS GetBlocks
ReadS [GetBlocks]
(Int -> ReadS GetBlocks)
-> ReadS [GetBlocks]
-> ReadPrec GetBlocks
-> ReadPrec [GetBlocks]
-> Read GetBlocks
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GetBlocks
readsPrec :: Int -> ReadS GetBlocks
$creadList :: ReadS [GetBlocks]
readList :: ReadS [GetBlocks]
$creadPrec :: ReadPrec GetBlocks
readPrec :: ReadPrec GetBlocks
$creadListPrec :: ReadPrec [GetBlocks]
readListPrec :: ReadPrec [GetBlocks]
Read, (forall x. GetBlocks -> Rep GetBlocks x)
-> (forall x. Rep GetBlocks x -> GetBlocks) -> Generic GetBlocks
forall x. Rep GetBlocks x -> GetBlocks
forall x. GetBlocks -> Rep GetBlocks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetBlocks -> Rep GetBlocks x
from :: forall x. GetBlocks -> Rep GetBlocks x
$cto :: forall x. Rep GetBlocks x -> GetBlocks
to :: forall x. Rep GetBlocks x -> GetBlocks
Generic, GetBlocks -> ()
(GetBlocks -> ()) -> NFData GetBlocks
forall a. (a -> ()) -> NFData a
$crnf :: GetBlocks -> ()
rnf :: GetBlocks -> ()
NFData)

instance Serial GetBlocks where
  deserialize :: forall (m :: * -> *). MonadGet m => m GetBlocks
deserialize =
    Word32 -> [BlockHash] -> BlockHash -> GetBlocks
GetBlocks
      (Word32 -> [BlockHash] -> BlockHash -> GetBlocks)
-> m Word32 -> m ([BlockHash] -> BlockHash -> GetBlocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
      m ([BlockHash] -> BlockHash -> GetBlocks)
-> m [BlockHash] -> m (BlockHash -> GetBlocks)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VarInt -> m [BlockHash]
forall {m :: * -> *} {a}. (Serial a, MonadGet m) => VarInt -> m [a]
repList (VarInt -> m [BlockHash]) -> m VarInt -> m [BlockHash]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarInt
deserialize)
      m (BlockHash -> GetBlocks) -> m BlockHash -> m GetBlocks
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m BlockHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHash
deserialize
    where
      repList :: VarInt -> m [a]
repList (VarInt Word64
c) = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize
  serialize :: forall (m :: * -> *). MonadPut m => GetBlocks -> m ()
serialize (GetBlocks Word32
v [BlockHash]
xs BlockHash
h) = do
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
v
    Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [BlockHash] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockHash]
xs
    [BlockHash] -> (BlockHash -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BlockHash]
xs BlockHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHash -> m ()
serialize
    BlockHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHash -> m ()
serialize BlockHash
h

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

-- | Similar to the 'GetBlocks' message type but for retrieving block headers
-- only. The response to a 'GetHeaders' request is a 'Headers' message
-- containing a list of block headers. A maximum of 2000 block headers can be
-- returned. 'GetHeaders' is used by simplified payment verification (SPV)
-- clients to exclude block contents when synchronizing the block chain.
data GetHeaders = GetHeaders
  { GetHeaders -> Word32
version :: !Word32,
    -- | block locator object
    GetHeaders -> [BlockHash]
locator :: !BlockLocator,
    -- | hash of the last desired block header
    GetHeaders -> BlockHash
stop :: !BlockHash
  }
  deriving (GetHeaders -> GetHeaders -> Bool
(GetHeaders -> GetHeaders -> Bool)
-> (GetHeaders -> GetHeaders -> Bool) -> Eq GetHeaders
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetHeaders -> GetHeaders -> Bool
== :: GetHeaders -> GetHeaders -> Bool
$c/= :: GetHeaders -> GetHeaders -> Bool
/= :: GetHeaders -> GetHeaders -> Bool
Eq, Int -> GetHeaders -> ShowS
[GetHeaders] -> ShowS
GetHeaders -> String
(Int -> GetHeaders -> ShowS)
-> (GetHeaders -> String)
-> ([GetHeaders] -> ShowS)
-> Show GetHeaders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetHeaders -> ShowS
showsPrec :: Int -> GetHeaders -> ShowS
$cshow :: GetHeaders -> String
show :: GetHeaders -> String
$cshowList :: [GetHeaders] -> ShowS
showList :: [GetHeaders] -> ShowS
Show, ReadPrec [GetHeaders]
ReadPrec GetHeaders
Int -> ReadS GetHeaders
ReadS [GetHeaders]
(Int -> ReadS GetHeaders)
-> ReadS [GetHeaders]
-> ReadPrec GetHeaders
-> ReadPrec [GetHeaders]
-> Read GetHeaders
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GetHeaders
readsPrec :: Int -> ReadS GetHeaders
$creadList :: ReadS [GetHeaders]
readList :: ReadS [GetHeaders]
$creadPrec :: ReadPrec GetHeaders
readPrec :: ReadPrec GetHeaders
$creadListPrec :: ReadPrec [GetHeaders]
readListPrec :: ReadPrec [GetHeaders]
Read, (forall x. GetHeaders -> Rep GetHeaders x)
-> (forall x. Rep GetHeaders x -> GetHeaders) -> Generic GetHeaders
forall x. Rep GetHeaders x -> GetHeaders
forall x. GetHeaders -> Rep GetHeaders x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetHeaders -> Rep GetHeaders x
from :: forall x. GetHeaders -> Rep GetHeaders x
$cto :: forall x. Rep GetHeaders x -> GetHeaders
to :: forall x. Rep GetHeaders x -> GetHeaders
Generic, GetHeaders -> ()
(GetHeaders -> ()) -> NFData GetHeaders
forall a. (a -> ()) -> NFData a
$crnf :: GetHeaders -> ()
rnf :: GetHeaders -> ()
NFData)

instance Serial GetHeaders where
  deserialize :: forall (m :: * -> *). MonadGet m => m GetHeaders
deserialize =
    Word32 -> [BlockHash] -> BlockHash -> GetHeaders
GetHeaders
      (Word32 -> [BlockHash] -> BlockHash -> GetHeaders)
-> m Word32 -> m ([BlockHash] -> BlockHash -> GetHeaders)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
      m ([BlockHash] -> BlockHash -> GetHeaders)
-> m [BlockHash] -> m (BlockHash -> GetHeaders)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VarInt -> m [BlockHash]
forall {m :: * -> *} {a}. (Serial a, MonadGet m) => VarInt -> m [a]
repList (VarInt -> m [BlockHash]) -> m VarInt -> m [BlockHash]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarInt
deserialize)
      m (BlockHash -> GetHeaders) -> m BlockHash -> m GetHeaders
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m BlockHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHash
deserialize
    where
      repList :: VarInt -> m [a]
repList (VarInt Word64
c) = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize
  serialize :: forall (m :: * -> *). MonadPut m => GetHeaders -> m ()
serialize (GetHeaders Word32
v [BlockHash]
xs BlockHash
h) = do
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
v
    Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [BlockHash] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockHash]
xs
    [BlockHash] -> (BlockHash -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BlockHash]
xs BlockHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHash -> m ()
serialize
    BlockHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHash -> m ()
serialize BlockHash
h

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

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

-- | 'BlockHeader' type with a transaction count as 'VarInt'
type BlockHeaderCount = (BlockHeader, VarInt)

-- | The 'Headers' type is used to return a list of block headers in
-- response to a 'GetHeaders' message.
newtype Headers = Headers
  { -- | list of block headers with transaction count
    Headers -> [BlockHeaderCount]
list :: [BlockHeaderCount]
  }
  deriving (Headers -> Headers -> Bool
(Headers -> Headers -> Bool)
-> (Headers -> Headers -> Bool) -> Eq Headers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Headers -> Headers -> Bool
== :: Headers -> Headers -> Bool
$c/= :: Headers -> Headers -> Bool
/= :: Headers -> Headers -> Bool
Eq, Int -> Headers -> ShowS
[Headers] -> ShowS
Headers -> String
(Int -> Headers -> ShowS)
-> (Headers -> String) -> ([Headers] -> ShowS) -> Show Headers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Headers -> ShowS
showsPrec :: Int -> Headers -> ShowS
$cshow :: Headers -> String
show :: Headers -> String
$cshowList :: [Headers] -> ShowS
showList :: [Headers] -> ShowS
Show, ReadPrec [Headers]
ReadPrec Headers
Int -> ReadS Headers
ReadS [Headers]
(Int -> ReadS Headers)
-> ReadS [Headers]
-> ReadPrec Headers
-> ReadPrec [Headers]
-> Read Headers
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Headers
readsPrec :: Int -> ReadS Headers
$creadList :: ReadS [Headers]
readList :: ReadS [Headers]
$creadPrec :: ReadPrec Headers
readPrec :: ReadPrec Headers
$creadListPrec :: ReadPrec [Headers]
readListPrec :: ReadPrec [Headers]
Read, (forall x. Headers -> Rep Headers x)
-> (forall x. Rep Headers x -> Headers) -> Generic Headers
forall x. Rep Headers x -> Headers
forall x. Headers -> Rep Headers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Headers -> Rep Headers x
from :: forall x. Headers -> Rep Headers x
$cto :: forall x. Rep Headers x -> Headers
to :: forall x. Rep Headers x -> Headers
Generic, Headers -> ()
(Headers -> ()) -> NFData Headers
forall a. (a -> ()) -> NFData a
$crnf :: Headers -> ()
rnf :: Headers -> ()
NFData)

instance Serial Headers where
  deserialize :: forall (m :: * -> *). MonadGet m => m Headers
deserialize = [BlockHeaderCount] -> Headers
Headers ([BlockHeaderCount] -> Headers)
-> m [BlockHeaderCount] -> m Headers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> m [BlockHeaderCount]
repList (VarInt -> m [BlockHeaderCount])
-> m VarInt -> m [BlockHeaderCount]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarInt
deserialize)
    where
      repList :: VarInt -> m [BlockHeaderCount]
repList (VarInt Word64
c) = Int -> m BlockHeaderCount -> m [BlockHeaderCount]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m BlockHeaderCount
action
      action :: m BlockHeaderCount
action = (BlockHeader -> VarInt -> BlockHeaderCount)
-> m BlockHeader -> m VarInt -> m BlockHeaderCount
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) m BlockHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHeader
deserialize m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m VarInt
deserialize
  serialize :: forall (m :: * -> *). MonadPut m => Headers -> m ()
serialize (Headers [BlockHeaderCount]
xs) = do
    Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [BlockHeaderCount] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockHeaderCount]
xs
    [BlockHeaderCount] -> (BlockHeaderCount -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BlockHeaderCount]
xs ((BlockHeaderCount -> m ()) -> m ())
-> (BlockHeaderCount -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(BlockHeader
a, VarInt
b) -> BlockHeader -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHeader -> m ()
serialize BlockHeader
a m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VarInt -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => VarInt -> m ()
serialize VarInt
b

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

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

-- | Decode the compact number used in the difficulty target of a block.
--
-- The compact format is a representation of a whole number \(N\) using an
-- unsigned 32-bit number similar to a floating point format. The most
-- significant 8 bits are the unsigned exponent of base 256. This exponent can
-- be thought of as the number of bytes of \(N\). The lower 23 bits are the
-- mantissa. Bit number 24 represents the sign of \(N\).
--
-- \[
-- N = -1^{sign} \times mantissa \times 256^{exponent-3}
-- \]
decodeCompact ::
  Word32 ->
  -- | true means overflow
  (Integer, Bool)
decodeCompact :: Word32 -> (Integer, Bool)
decodeCompact Word32
nCompact = (if Bool
neg then Integer
res Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (-Integer
1) else Integer
res, Bool
over)
  where
    nSize :: Int
    nSize :: Int
nSize = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nCompact Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
24
    nWord' :: Word32
    nWord' :: Word32
nWord' = Word32
nCompact Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x007fffff
    nWord :: Word32
    nWord :: Word32
nWord
      | Int
nSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 = Word32
nWord' Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nSize))
      | Bool
otherwise = Word32
nWord'
    res :: Integer
    res :: Integer
res
      | Int
nSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nWord
      | Bool
otherwise = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nWord Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3))
    neg :: Bool
neg = Word32
nWord Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 Bool -> Bool -> Bool
&& (Word32
nCompact Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x00800000) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
    over :: Bool
over =
      Word32
nWord Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
        Bool -> Bool -> Bool
&& ( Int
nSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
34
               Bool -> Bool -> Bool
|| Word32
nWord Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0xff Bool -> Bool -> Bool
&& Int
nSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
33
               Bool -> Bool -> Bool
|| Word32
nWord Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0xffff Bool -> Bool -> Bool
&& Int
nSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
32
           )

-- | Encode an 'Integer' to the compact number format used in the difficulty
-- target of a block.
encodeCompact :: Integer -> Word32
encodeCompact :: Integer -> Word32
encodeCompact Integer
i = Word32
nCompact
  where
    i' :: Integer
i' = Integer -> Integer
forall a. Num a => a -> a
abs Integer
i
    neg :: Bool
neg = Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
    nSize' :: Int
    nSize' :: Int
nSize' =
      let f :: t -> a
f t
0 = a
0
          f t
n = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ t -> a
f (t
n t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
       in Integer -> Int
forall {t} {a}. (Num t, Num a, Bits t) => t -> a
f Integer
i'
    nCompact''' :: Word32
    nCompact''' :: Word32
nCompact'''
      | Int
nSize' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ (Integer
low64 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
i') Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nSize'))
      | Bool
otherwise = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Integer
low64 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Integer
i' Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nSize' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)))
    nCompact'' :: Word32
    nSize :: Int
    (Word32
nCompact'', Int
nSize)
      | Word32
nCompact''' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x00800000 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 = (Word32
nCompact''' Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8, Int
nSize' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise = (Word32
nCompact''', Int
nSize')
    nCompact' :: Word32
    nCompact' :: Word32
nCompact' = Word32
nCompact'' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nSize Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
    nCompact :: Word32
    nCompact :: Word32
nCompact
      | Bool
neg Bool -> Bool -> Bool
&& (Word32
nCompact' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x007fffff Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0) = Word32
nCompact' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
0x00800000
      | Bool
otherwise = Word32
nCompact'
    low64 :: Integer
    low64 :: Integer
low64 = Integer
0xffffffffffffffff