{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
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              (forM_, liftM2, mzero, replicateM)
import           Data.Aeson                 (FromJSON (..), ToJSON (..),
                                             Value (..), object, toJSON,
                                             withObject, withText, (.:), (.=))
import           Data.Aeson.Encoding        (pairs, unsafeToEncoding)
import           Data.Binary                (Binary (..))
import           Data.Bits                  (shiftL, shiftR, (.&.), (.|.))
import qualified Data.ByteString            as B
import           Data.ByteString.Builder    (char7)
import qualified Data.ByteString.Lazy       as BL
import           Data.Bytes.Get             (MonadGet, getWord32le, runGetL,
                                             runGetS)
import           Data.Bytes.Put             (MonadPut, putWord32le, runPutL,
                                             runPutS)
import           Data.Bytes.Serial          (Serial (..))
import           Data.Hashable              (Hashable)
import           Data.Maybe                 (fromMaybe)
import           Data.Serialize             (Serialize (..))
import           Data.String                (IsString, fromString)
import           Data.String.Conversions    (cs)
import           Data.Text                  (Text)
import           Data.Word                  (Word32)
import           GHC.Generics               (Generic)
import           Haskoin.Crypto.Hash
import           Haskoin.Network.Common
import           Haskoin.Transaction.Common
import           Haskoin.Util
import qualified Text.Read                  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
blockHeader :: !BlockHeader
    , Block -> [Tx]
blockTxns   :: ![Tx]
    }
    deriving (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: 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
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Block]
$creadListPrec :: ReadPrec [Block]
readPrec :: ReadPrec Block
$creadPrec :: ReadPrec Block
readList :: ReadS [Block]
$creadList :: ReadS [Block]
readsPrec :: Int -> ReadS Block
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic, Int -> Block -> Int
Block -> Int
(Int -> Block -> Int) -> (Block -> Int) -> Hashable Block
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Block -> Int
$chash :: Block -> Int
hashWithSalt :: Int -> Block -> Int
$chashWithSalt :: Int -> Block -> Int
Hashable, Block -> ()
(Block -> ()) -> NFData Block
forall a. (a -> ()) -> NFData a
rnf :: Block -> ()
$crnf :: Block -> ()
NFData)

instance Serial Block where
    deserialize :: m Block
deserialize = do
        BlockHeader
header <- m BlockHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        (VarInt c :: Word64
c) <- m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
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
deserialize
        Block -> m Block
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 :: Block -> m ()
serialize (Block h :: BlockHeader
h txs :: [Tx]
txs) = do
        BlockHeader -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> 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 (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 ()
serialize

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

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

instance ToJSON Block where
    toJSON :: Block -> Value
toJSON (Block h :: BlockHeader
h t :: [Tx]
t) = [Pair] -> Value
object ["header" Text -> BlockHeader -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader
h, "transactions" Text -> [Tx] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Tx]
t]
    toEncoding :: Block -> Encoding
toEncoding (Block h :: BlockHeader
h t :: [Tx]
t) = Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ "header" Text -> BlockHeader -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader
h Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "transactions" Text -> [Tx] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [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 "Block" ((Object -> Parser Block) -> Value -> Parser Block)
-> (Object -> Parser Block) -> Value -> Parser Block
forall a b. (a -> b) -> a -> b
$ \o :: 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 -> Text -> Parser BlockHeader
forall a. FromJSON a => Object -> Text -> Parser a
.: "header" Parser ([Tx] -> Block) -> Parser [Tx] -> Parser Block
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Tx]
forall a. FromJSON a => Object -> Text -> Parser a
.: "transactions"

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

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

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

instance Show BlockHash where
    showsPrec :: Int -> BlockHash -> ShowS
showsPrec _ = 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 str :: 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 (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 s :: String
s =
        let e :: a
e = String -> a
forall a. HasCallStack => String -> a
error "Could not read block hash from hex string"
        in BlockHash -> Maybe BlockHash -> BlockHash
forall a. a -> Maybe a -> a
fromMaybe BlockHash
forall a. a
e (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 "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 (m :: * -> *) a. MonadPlus m => m a
mzero BlockHash -> Parser BlockHash
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 h :: BlockHash
h =
        Builder -> Encoding
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding) -> Builder -> Encoding
forall a b. (a -> b) -> a -> b
$
        Char -> Builder
char7 '"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        ByteString -> Builder
hexBuilder (ByteString -> ByteString
BL.reverse (Put -> ByteString
runPutL (BlockHash -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHash
h))) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Char -> Builder
char7 '"'

-- | 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 h :: Hash256
h) = ByteString -> Text
encodeHex (ByteString -> ByteString
B.reverse (Put -> ByteString
runPutS (Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> 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 hex :: 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
deserialize ByteString
bs)
    BlockHash -> Maybe BlockHash
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
blockVersion   :: !Word32 --  4 bytes
    -- | hash of the previous block (parent)
    , BlockHeader -> BlockHash
prevBlock      :: !BlockHash -- 32 bytes
    -- | root of the merkle tree of transactions
    , BlockHeader -> Hash256
merkleRoot     :: !Hash256 -- 32 bytes
    -- | unix timestamp
    , BlockHeader -> Word32
blockTimestamp :: !Timestamp --  4 bytes
    -- | difficulty target
    , BlockHeader -> Word32
blockBits      :: !Word32 --  4 bytes
    -- | random nonce
    , BlockHeader -> Word32
bhNonce        :: !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
/= :: BlockHeader -> BlockHeader -> Bool
$c/= :: BlockHeader -> BlockHeader -> Bool
== :: BlockHeader -> BlockHeader -> Bool
$c== :: 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
min :: BlockHeader -> BlockHeader -> BlockHeader
$cmin :: BlockHeader -> BlockHeader -> BlockHeader
max :: BlockHeader -> BlockHeader -> BlockHeader
$cmax :: BlockHeader -> BlockHeader -> BlockHeader
>= :: BlockHeader -> BlockHeader -> Bool
$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
compare :: BlockHeader -> BlockHeader -> Ordering
$ccompare :: BlockHeader -> BlockHeader -> Ordering
$cp1Ord :: Eq 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
showList :: [BlockHeader] -> ShowS
$cshowList :: [BlockHeader] -> ShowS
show :: BlockHeader -> String
$cshow :: BlockHeader -> String
showsPrec :: Int -> BlockHeader -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [BlockHeader]
$creadListPrec :: ReadPrec [BlockHeader]
readPrec :: ReadPrec BlockHeader
$creadPrec :: ReadPrec BlockHeader
readList :: ReadS [BlockHeader]
$creadList :: ReadS [BlockHeader]
readsPrec :: Int -> ReadS BlockHeader
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep BlockHeader x -> BlockHeader
$cfrom :: forall x. BlockHeader -> Rep BlockHeader x
Generic, Int -> BlockHeader -> Int
BlockHeader -> Int
(Int -> BlockHeader -> Int)
-> (BlockHeader -> Int) -> Hashable BlockHeader
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlockHeader -> Int
$chash :: BlockHeader -> Int
hashWithSalt :: Int -> BlockHeader -> Int
$chashWithSalt :: Int -> BlockHeader -> Int
Hashable, BlockHeader -> ()
(BlockHeader -> ()) -> NFData BlockHeader
forall a. (a -> ()) -> NFData a
rnf :: BlockHeader -> ()
$crnf :: BlockHeader -> ()
NFData)
                                                 -- 80 bytes

instance ToJSON BlockHeader where
    toJSON :: BlockHeader -> Value
toJSON (BlockHeader v :: Word32
v p :: BlockHash
p m :: Hash256
m t :: Word32
t b :: Word32
b n :: Word32
n) =
        [Pair] -> Value
object
            [ "version" Text -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32
v
            , "prevblock" Text -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHash
p
            , "merkleroot" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex (Put -> ByteString
runPutS (Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
m))
            , "timestamp" Text -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32
t
            , "bits" Text -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32
b
            , "nonce" Text -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32
n
            ]
    toEncoding :: BlockHeader -> Encoding
toEncoding (BlockHeader v :: Word32
v p :: BlockHash
p m :: Hash256
m t :: Word32
t b :: Word32
b n :: Word32
n) =
        Series -> Encoding
pairs
            ( "version" Text -> Word32 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32
v
           Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "prevblock" Text -> BlockHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHash
p
           Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "merkleroot" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex (Put -> ByteString
runPutS (Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
m))
           Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "timestamp" Text -> Word32 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32
t
           Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "bits" Text -> Word32 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32
b
           Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "nonce" Text -> Word32 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= 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 "BlockHeader" ((Object -> Parser BlockHeader) -> Value -> Parser BlockHeader)
-> (Object -> Parser BlockHeader) -> Value -> Parser BlockHeader
forall a b. (a -> b) -> a -> b
$ \o :: 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 -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "version"
                        Parser
  (BlockHash -> Hash256 -> Word32 -> Word32 -> Word32 -> BlockHeader)
-> Parser BlockHash
-> Parser (Hash256 -> Word32 -> Word32 -> Word32 -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "prevblock"
                        Parser (Hash256 -> Word32 -> Word32 -> Word32 -> BlockHeader)
-> Parser Hash256
-> Parser (Word32 -> Word32 -> Word32 -> BlockHeader)
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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "merkleroot")
                        Parser (Word32 -> Word32 -> Word32 -> BlockHeader)
-> Parser Word32 -> Parser (Word32 -> Word32 -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "timestamp"
                        Parser (Word32 -> Word32 -> BlockHeader)
-> Parser Word32 -> Parser (Word32 -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "bits"
                        Parser (Word32 -> BlockHeader)
-> Parser Word32 -> Parser BlockHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 (m :: * -> *) a. MonadPlus m => m a
mzero
            Hash256 -> Parser Hash256
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
deserialize (ByteString -> Maybe Hash256) -> Maybe ByteString -> Maybe Hash256
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe ByteString -> Maybe Hash256)
-> (Text -> Maybe ByteString) -> Text -> Maybe Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Text -> Maybe ByteString
decodeHex

instance Serial BlockHeader where
    deserialize :: 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
deserialize
        Hash256
m <- m Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
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 (m :: * -> *) a. Monad m => a -> m a
return
            $WBlockHeader :: Word32
-> BlockHash
-> Hash256
-> Word32
-> Word32
-> Word32
-> BlockHeader
BlockHeader
                { blockVersion :: Word32
blockVersion = Word32
v
                , prevBlock :: BlockHash
prevBlock = BlockHash
p
                , merkleRoot :: Hash256
merkleRoot = Hash256
m
                , blockTimestamp :: Word32
blockTimestamp = Word32
t
                , blockBits :: Word32
blockBits = Word32
b
                , bhNonce :: Word32
bhNonce = Word32
n
                }
    serialize :: BlockHeader -> m ()
serialize (BlockHeader v :: Word32
v p :: BlockHash
p m :: Hash256
m bt :: Word32
bt bb :: Word32
bb n :: 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 ()
serialize BlockHash
p
        Hash256 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> 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 ()
serialize
    get :: Get BlockHeader
get = Get BlockHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serialize BlockHeader where
    put :: Putter BlockHeader
put = Putter BlockHeader
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get BlockHeader
get = Get BlockHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
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 ()
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
getBlocksVersion  :: !Word32
    -- | block locator object
    , GetBlocks -> [BlockHash]
getBlocksLocator  :: !BlockLocator
    -- | hash of the last desired block
    , GetBlocks -> BlockHash
getBlocksHashStop :: !BlockHash
    }
    deriving (GetBlocks -> GetBlocks -> Bool
(GetBlocks -> GetBlocks -> Bool)
-> (GetBlocks -> GetBlocks -> Bool) -> Eq GetBlocks
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBlocks -> GetBlocks -> Bool
$c/= :: GetBlocks -> GetBlocks -> Bool
== :: GetBlocks -> GetBlocks -> Bool
$c== :: 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
showList :: [GetBlocks] -> ShowS
$cshowList :: [GetBlocks] -> ShowS
show :: GetBlocks -> String
$cshow :: GetBlocks -> String
showsPrec :: Int -> GetBlocks -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [GetBlocks]
$creadListPrec :: ReadPrec [GetBlocks]
readPrec :: ReadPrec GetBlocks
$creadPrec :: ReadPrec GetBlocks
readList :: ReadS [GetBlocks]
$creadList :: ReadS [GetBlocks]
readsPrec :: Int -> ReadS GetBlocks
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep GetBlocks x -> GetBlocks
$cfrom :: forall x. GetBlocks -> Rep GetBlocks x
Generic, GetBlocks -> ()
(GetBlocks -> ()) -> NFData GetBlocks
forall a. (a -> ()) -> NFData a
rnf :: GetBlocks -> ()
$crnf :: GetBlocks -> ()
NFData)

instance Serial GetBlocks where
    deserialize :: 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 (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
deserialize)
        m (BlockHash -> GetBlocks) -> m BlockHash -> m GetBlocks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m BlockHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
      where
        repList :: VarInt -> m [a]
repList (VarInt c :: 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
deserialize
    serialize :: GetBlocks -> m ()
serialize (GetBlocks v :: Word32
v xs :: [BlockHash]
xs h :: BlockHash
h) = Word32 -> [BlockHash] -> BlockHash -> m ()
forall (m :: * -> *).
MonadPut m =>
Word32 -> [BlockHash] -> BlockHash -> m ()
putGetBlockMsg Word32
v [BlockHash]
xs BlockHash
h

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

putGetBlockMsg :: MonadPut m => Word32 -> BlockLocator -> BlockHash -> m ()
putGetBlockMsg :: Word32 -> [BlockHash] -> BlockHash -> m ()
putGetBlockMsg v :: Word32
v xs :: [BlockHash]
xs h :: 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 (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 ()
serialize
    BlockHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHash
h

-- | 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
getHeadersVersion  :: !Word32
    -- | block locator object
    , GetHeaders -> [BlockHash]
getHeadersBL       :: !BlockLocator
    -- | hash of the last desired block header
    , GetHeaders -> BlockHash
getHeadersHashStop :: !BlockHash
    }
    deriving (GetHeaders -> GetHeaders -> Bool
(GetHeaders -> GetHeaders -> Bool)
-> (GetHeaders -> GetHeaders -> Bool) -> Eq GetHeaders
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHeaders -> GetHeaders -> Bool
$c/= :: GetHeaders -> GetHeaders -> Bool
== :: GetHeaders -> GetHeaders -> Bool
$c== :: 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
showList :: [GetHeaders] -> ShowS
$cshowList :: [GetHeaders] -> ShowS
show :: GetHeaders -> String
$cshow :: GetHeaders -> String
showsPrec :: Int -> GetHeaders -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [GetHeaders]
$creadListPrec :: ReadPrec [GetHeaders]
readPrec :: ReadPrec GetHeaders
$creadPrec :: ReadPrec GetHeaders
readList :: ReadS [GetHeaders]
$creadList :: ReadS [GetHeaders]
readsPrec :: Int -> ReadS GetHeaders
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep GetHeaders x -> GetHeaders
$cfrom :: forall x. GetHeaders -> Rep GetHeaders x
Generic, GetHeaders -> ()
(GetHeaders -> ()) -> NFData GetHeaders
forall a. (a -> ()) -> NFData a
rnf :: GetHeaders -> ()
$crnf :: GetHeaders -> ()
NFData)

instance Serial GetHeaders where
    deserialize :: 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 (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
deserialize)
        m (BlockHash -> GetHeaders) -> m BlockHash -> m GetHeaders
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m BlockHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
      where
        repList :: VarInt -> m [a]
repList (VarInt c :: 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
deserialize
    serialize :: GetHeaders -> m ()
serialize (GetHeaders v :: Word32
v xs :: [BlockHash]
xs h :: BlockHash
h) = Word32 -> [BlockHash] -> BlockHash -> m ()
forall (m :: * -> *).
MonadPut m =>
Word32 -> [BlockHash] -> BlockHash -> m ()
putGetBlockMsg Word32
v [BlockHash]
xs BlockHash
h

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

instance Binary GetHeaders where
    put :: GetHeaders -> Put
put = GetHeaders -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get GetHeaders
get = Get GetHeaders
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
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]
headersList :: [BlockHeaderCount]
    } deriving (Headers -> Headers -> Bool
(Headers -> Headers -> Bool)
-> (Headers -> Headers -> Bool) -> Eq Headers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Headers -> Headers -> Bool
$c/= :: Headers -> Headers -> Bool
== :: Headers -> Headers -> Bool
$c== :: 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
showList :: [Headers] -> ShowS
$cshowList :: [Headers] -> ShowS
show :: Headers -> String
$cshow :: Headers -> String
showsPrec :: Int -> Headers -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Headers]
$creadListPrec :: ReadPrec [Headers]
readPrec :: ReadPrec Headers
$creadPrec :: ReadPrec Headers
readList :: ReadS [Headers]
$creadList :: ReadS [Headers]
readsPrec :: Int -> ReadS Headers
$creadsPrec :: Int -> ReadS 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
$cto :: forall x. Rep Headers x -> Headers
$cfrom :: forall x. Headers -> Rep Headers x
Generic, Headers -> ()
(Headers -> ()) -> NFData Headers
forall a. (a -> ()) -> NFData a
rnf :: Headers -> ()
$crnf :: Headers -> ()
NFData)

instance Serial Headers where
    deserialize :: 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
deserialize)
      where
        repList :: VarInt -> m [BlockHeaderCount]
repList (VarInt c :: 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
deserialize m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    serialize :: Headers -> m ()
serialize (Headers xs :: [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 (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
$ \(a :: BlockHeader
a, b :: VarInt
b) -> BlockHeader -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHeader
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VarInt -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize VarInt
b

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

instance Binary Headers where
    put :: Headers -> Put
put = Headers -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get Headers
get = Get Headers
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
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 -> (Integer, Bool) -- ^ true means overflow
decodeCompact :: Word32 -> (Integer, Bool)
decodeCompact nCompact :: Word32
nCompact = (if Bool
neg then Integer
res Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (-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` 24
    nWord' :: Word32
    nWord' :: Word32
nWord' = Word32
nCompact Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x007fffff
    nWord :: Word32
    nWord :: Word32
nWord | Int
nSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 3 = Word32
nWord' Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (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
<= 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` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3))
    neg :: Bool
neg = Word32
nWord Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
&& (Word32
nCompact Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x00800000) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
    over :: Bool
over = Word32
nWord Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
&& (Int
nSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 34 Bool -> Bool -> Bool
||
                          Word32
nWord Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> 0xff Bool -> Bool -> Bool
&& Int
nSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 33 Bool -> Bool -> Bool
||
                          Word32
nWord Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> 0xffff Bool -> Bool -> Bool
&& Int
nSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 32)

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