{-# 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.Bits                  (shiftL, shiftR, (.&.), (.|.))
import qualified Data.ByteString            as B
import           Data.ByteString.Builder    (char7)
import           Data.Hashable              (Hashable)
import           Data.Maybe                 (fromMaybe)
import           Data.Serialize             (Serialize, decode, encode, get,
                                             put)
import           Data.Serialize.Get         (getWord32le)
import           Data.Serialize.Put         (Put, putWord32le)
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 Serialize Block where
    get :: Get Block
get = do
        BlockHeader
header <- Get BlockHeader
forall t. Serialize t => Get t
get
        (VarInt c :: Word64
c) <- Get VarInt
forall t. Serialize t => Get t
get
        [Tx]
txs <- Int -> Get Tx -> Get [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) Get Tx
forall t. Serialize t => Get t
get
        Block -> Get Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Get Block) -> Block -> Get Block
forall a b. (a -> b) -> a -> b
$ BlockHeader -> [Tx] -> Block
Block BlockHeader
header [Tx]
txs
    put :: Putter Block
put (Block h :: BlockHeader
h txs :: [Tx]
txs) = do
        Putter BlockHeader
forall t. Serialize t => Putter t
put BlockHeader
h
        Int -> Put
forall a. Integral a => a -> Put
putVarInt (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ [Tx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
txs
        [Tx] -> (Tx -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Tx]
txs Tx -> Put
forall t. Serialize t => Putter t
put

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, Get BlockHash
Putter BlockHash
Putter BlockHash -> Get BlockHash -> Serialize BlockHash
forall t. Putter t -> Get t -> Serialize t
get :: Get BlockHash
$cget :: Get BlockHash
put :: Putter BlockHash
$cput :: Putter BlockHash
Serialize, BlockHash -> ()
(BlockHash -> ()) -> NFData BlockHash
forall a. (a -> ()) -> NFData a
rnf :: BlockHash -> ()
$crnf :: BlockHash -> ()
NFData)

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
B.reverse (BlockHash -> ByteString
forall a. Serialize a => a -> ByteString
encode 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 (Hash256 -> ByteString
forall a. Serialize a => a -> ByteString
encode 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 (ByteString -> Either String Hash256
forall a. Serialize a => ByteString -> Either String a
decode 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 (Hash256 -> ByteString
forall a. Serialize a => a -> ByteString
encode 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 (Hash256 -> ByteString
forall a. Serialize a => a -> ByteString
encode 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
. ByteString -> Either String Hash256
forall a. Serialize a => ByteString -> Either String a
decode (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 Serialize BlockHeader where
    get :: Get BlockHeader
get = do
        Word32
v <- Get Word32
getWord32le
        BlockHash
p <- Get BlockHash
forall t. Serialize t => Get t
get
        Hash256
m <- Get Hash256
forall t. Serialize t => Get t
get
        Word32
t <- Get Word32
getWord32le
        Word32
b <- Get Word32
getWord32le
        Word32
n <- Get Word32
getWord32le
        BlockHeader -> Get 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
                }
    put :: Putter BlockHeader
put (BlockHeader v :: Word32
v p :: BlockHash
p m :: Hash256
m bt :: Word32
bt bb :: Word32
bb n :: Word32
n) = do
        Putter Word32
putWord32le Word32
v
        Putter BlockHash
forall t. Serialize t => Putter t
put BlockHash
p
        Putter Hash256
forall t. Serialize t => Putter t
put Hash256
m
        Putter Word32
putWord32le Word32
bt
        Putter Word32
putWord32le Word32
bb
        Putter Word32
putWord32le Word32
n

-- | 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
. BlockHeader -> ByteString
forall a. Serialize a => a -> ByteString
encode

-- | 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 Serialize GetBlocks where
    get :: Get GetBlocks
get = Word32 -> [BlockHash] -> BlockHash -> GetBlocks
GetBlocks (Word32 -> [BlockHash] -> BlockHash -> GetBlocks)
-> Get Word32 -> Get ([BlockHash] -> BlockHash -> GetBlocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le Get ([BlockHash] -> BlockHash -> GetBlocks)
-> Get [BlockHash] -> Get (BlockHash -> GetBlocks)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VarInt -> Get [BlockHash]
forall a. Serialize a => VarInt -> Get [a]
repList (VarInt -> Get [BlockHash]) -> Get VarInt -> Get [BlockHash]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get VarInt
forall t. Serialize t => Get t
get) Get (BlockHash -> GetBlocks) -> Get BlockHash -> Get GetBlocks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BlockHash
forall t. Serialize t => Get t
get
      where
        repList :: VarInt -> Get [a]
repList (VarInt c :: Word64
c) = Int -> Get a -> Get [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) Get a
forall t. Serialize t => Get t
get
    put :: Putter GetBlocks
put (GetBlocks v :: Word32
v xs :: [BlockHash]
xs h :: BlockHash
h) = Word32 -> [BlockHash] -> Putter BlockHash
putGetBlockMsg Word32
v [BlockHash]
xs BlockHash
h

putGetBlockMsg :: Word32 -> BlockLocator -> BlockHash -> Put
putGetBlockMsg :: Word32 -> [BlockHash] -> Putter BlockHash
putGetBlockMsg v :: Word32
v xs :: [BlockHash]
xs h :: BlockHash
h = do
    Putter Word32
putWord32le Word32
v
    Int -> Put
forall a. Integral a => a -> Put
putVarInt (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ [BlockHash] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockHash]
xs
    [BlockHash] -> Putter BlockHash -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BlockHash]
xs Putter BlockHash
forall t. Serialize t => Putter t
put
    Putter BlockHash
forall t. Serialize t => Putter t
put 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 Serialize GetHeaders where
    get :: Get GetHeaders
get = Word32 -> [BlockHash] -> BlockHash -> GetHeaders
GetHeaders (Word32 -> [BlockHash] -> BlockHash -> GetHeaders)
-> Get Word32 -> Get ([BlockHash] -> BlockHash -> GetHeaders)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le Get ([BlockHash] -> BlockHash -> GetHeaders)
-> Get [BlockHash] -> Get (BlockHash -> GetHeaders)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VarInt -> Get [BlockHash]
forall a. Serialize a => VarInt -> Get [a]
repList (VarInt -> Get [BlockHash]) -> Get VarInt -> Get [BlockHash]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get VarInt
forall t. Serialize t => Get t
get) Get (BlockHash -> GetHeaders) -> Get BlockHash -> Get GetHeaders
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BlockHash
forall t. Serialize t => Get t
get
      where
        repList :: VarInt -> Get [a]
repList (VarInt c :: Word64
c) = Int -> Get a -> Get [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) Get a
forall t. Serialize t => Get t
get
    put :: Putter GetHeaders
put (GetHeaders v :: Word32
v xs :: [BlockHash]
xs h :: BlockHash
h) = Word32 -> [BlockHash] -> Putter BlockHash
putGetBlockMsg Word32
v [BlockHash]
xs BlockHash
h

-- | '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 Serialize Headers where
    get :: Get Headers
get = [BlockHeaderCount] -> Headers
Headers ([BlockHeaderCount] -> Headers)
-> Get [BlockHeaderCount] -> Get Headers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> Get [BlockHeaderCount]
repList (VarInt -> Get [BlockHeaderCount])
-> Get VarInt -> Get [BlockHeaderCount]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get VarInt
forall t. Serialize t => Get t
get)
      where
        repList :: VarInt -> Get [BlockHeaderCount]
repList (VarInt c :: Word64
c) = Int -> Get BlockHeaderCount -> Get [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) Get BlockHeaderCount
action
        action :: Get BlockHeaderCount
action = (BlockHeader -> VarInt -> BlockHeaderCount)
-> Get BlockHeader -> Get VarInt -> Get BlockHeaderCount
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Get BlockHeader
forall t. Serialize t => Get t
get Get VarInt
forall t. Serialize t => Get t
get
    put :: Putter Headers
put (Headers xs :: [BlockHeaderCount]
xs) = do
        Int -> Put
forall a. Integral a => a -> Put
putVarInt (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ [BlockHeaderCount] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockHeaderCount]
xs
        [BlockHeaderCount] -> (BlockHeaderCount -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BlockHeaderCount]
xs ((BlockHeaderCount -> Put) -> Put)
-> (BlockHeaderCount -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \(a :: BlockHeader
a, b :: VarInt
b) -> Putter BlockHeader
forall t. Serialize t => Putter t
put BlockHeader
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter VarInt
forall t. Serialize t => Putter t
put VarInt
b

-- | 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