{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Block.Common (
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
type BlockHeight = Word32
type Timestamp = Word32
data Block = Block
{ :: !BlockHeader
, Block -> [Tx]
blockTxns :: ![Tx]
}
deriving (Block -> Block -> Bool
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
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]
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. 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, Eq Block
Int -> Block -> Int
Block -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Block -> Int
$chash :: Block -> Int
hashWithSalt :: Int -> Block -> Int
$chashWithSalt :: Int -> Block -> Int
Hashable, Block -> ()
forall a. (a -> ()) -> NFData a
rnf :: Block -> ()
$crnf :: Block -> ()
NFData)
instance Serial Block where
deserialize :: forall (m :: * -> *). MonadGet m => m Block
deserialize = do
BlockHeader
header <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
(VarInt Word64
c) <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
[Tx]
txs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BlockHeader -> [Tx] -> Block
Block BlockHeader
header [Tx]
txs
serialize :: forall (m :: * -> *). MonadPut m => Block -> m ()
serialize (Block BlockHeader
h [Tx]
txs) = do
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHeader
h
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
txs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Tx]
txs forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
instance Serialize Block where
get :: Get Block
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
put :: Putter Block
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
instance Binary Block where
get :: Get Block
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
put :: Block -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
instance ToJSON Block where
toJSON :: Block -> Value
toJSON (Block BlockHeader
h [Tx]
t) = [Pair] -> Value
object [Key
"header" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockHeader
h, Key
"transactions" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Tx]
t]
toEncoding :: Block -> Encoding
toEncoding (Block BlockHeader
h [Tx]
t) = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key
"header" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockHeader
h forall a. Semigroup a => a -> a -> a
<> Key
"transactions" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Tx]
t
instance FromJSON Block where
parseJSON :: Value -> Parser Block
parseJSON =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Block" forall a b. (a -> b) -> a -> b
$ \Object
o ->
BlockHeader -> [Tx] -> Block
Block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"header" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transactions"
newtype BlockHash = BlockHash
{ BlockHash -> Hash256
getBlockHash :: Hash256
}
deriving (BlockHash -> BlockHash -> Bool
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
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
Ord, 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, Eq BlockHash
Int -> BlockHash -> Int
BlockHash -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlockHash -> Int
$chash :: BlockHash -> Int
hashWithSalt :: Int -> BlockHash -> Int
$chashWithSalt :: Int -> BlockHash -> Int
Hashable, forall a.
(forall (m :: * -> *). MonadPut m => a -> m ())
-> (forall (m :: * -> *). MonadGet m => m a) -> Serial a
forall (m :: * -> *). MonadGet m => m BlockHash
forall (m :: * -> *). MonadPut m => BlockHash -> m ()
deserialize :: forall (m :: * -> *). MonadGet m => m BlockHash
$cdeserialize :: forall (m :: * -> *). MonadGet m => m BlockHash
serialize :: forall (m :: * -> *). MonadPut m => BlockHash -> m ()
$cserialize :: forall (m :: * -> *). MonadPut m => BlockHash -> m ()
Serial, BlockHash -> ()
forall a. (a -> ()) -> NFData a
rnf :: BlockHash -> ()
$crnf :: BlockHash -> ()
NFData)
instance Serialize BlockHash where
put :: Putter BlockHash
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get BlockHash
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Binary BlockHash where
put :: BlockHash -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get BlockHash
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Show BlockHash where
showsPrec :: Int -> BlockHash -> ShowS
showsPrec Int
_ = forall a. Show a => a -> ShowS
shows forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> Text
blockHashToHex
instance Read BlockHash where
readPrec :: ReadPrec BlockHash
readPrec = do
R.String String
str <- ReadPrec Lexeme
R.lexP
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
R.pfail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Maybe BlockHash
hexToBlockHash forall a b. (a -> b) -> a -> b
$ forall a b. ConvertibleStrings a b => a -> b
cs String
str
instance IsString BlockHash where
fromString :: String -> BlockHash
fromString String
s =
let e :: a
e = forall a. HasCallStack => String -> a
error String
"Could not read block hash from hex string"
in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e forall a b. (a -> b) -> a -> b
$ Text -> Maybe BlockHash
hexToBlockHash forall a b. (a -> b) -> a -> b
$ forall a b. ConvertibleStrings a b => a -> b
cs String
s
instance FromJSON BlockHash where
parseJSON :: Value -> Parser BlockHash
parseJSON =
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"BlockHash" forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> Text
blockHashToHex
toEncoding :: BlockHash -> Encoding
toEncoding BlockHash
h =
forall a. Builder -> Encoding' a
unsafeToEncoding forall a b. (a -> b) -> a -> b
$
Char -> Builder
char7 Char
'"'
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
hexBuilder (ByteString -> ByteString
BL.reverse (Put -> ByteString
runPutL (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHash
h)))
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'"'
blockHashToHex :: BlockHash -> Text
blockHashToHex :: BlockHash -> Text
blockHashToHex (BlockHash Hash256
h) = ByteString -> Text
encodeHex (ByteString -> ByteString
B.reverse (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
h)))
hexToBlockHash :: Text -> Maybe BlockHash
hexToBlockHash :: Text -> Maybe BlockHash
hexToBlockHash Text
hex = do
ByteString
bs <- ByteString -> ByteString
B.reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe ByteString
decodeHex Text
hex
Hash256
h <- forall a b. Either a b -> Maybe b
eitherToMaybe (forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
bs)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Hash256 -> BlockHash
BlockHash Hash256
h
data =
{ BlockHeader -> Word32
blockVersion :: !Word32
,
BlockHeader -> BlockHash
prevBlock :: !BlockHash
,
BlockHeader -> Hash256
merkleRoot :: !Hash256
,
BlockHeader -> Word32
blockTimestamp :: !Timestamp
,
BlockHeader -> Word32
blockBits :: !Word32
,
BlockHeader -> Word32
bhNonce :: !Word32
}
deriving (BlockHeader -> BlockHeader -> Bool
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
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
Ord, Int -> BlockHeader -> ShowS
[BlockHeader] -> ShowS
BlockHeader -> String
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]
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. 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, Eq BlockHeader
Int -> BlockHeader -> Int
BlockHeader -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlockHeader -> Int
$chash :: BlockHeader -> Int
hashWithSalt :: Int -> BlockHeader -> Int
$chashWithSalt :: Int -> BlockHeader -> Int
Hashable, BlockHeader -> ()
forall a. (a -> ()) -> NFData a
rnf :: BlockHeader -> ()
$crnf :: BlockHeader -> ()
NFData)
instance ToJSON BlockHeader where
toJSON :: BlockHeader -> Value
toJSON (BlockHeader Word32
v BlockHash
p Hash256
m Word32
t Word32
b Word32
n) =
[Pair] -> Value
object
[ Key
"version" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
v
, Key
"prevblock" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockHash
p
, Key
"merkleroot" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
encodeHex (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
m))
, Key
"timestamp" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
t
, Key
"bits" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
b
, Key
"nonce" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
n
]
toEncoding :: BlockHeader -> Encoding
toEncoding (BlockHeader Word32
v BlockHash
p Hash256
m Word32
t Word32
b Word32
n) =
Series -> Encoding
pairs
( Key
"version" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
v
forall a. Semigroup a => a -> a -> a
<> Key
"prevblock" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockHash
p
forall a. Semigroup a => a -> a -> a
<> Key
"merkleroot" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
encodeHex (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
m))
forall a. Semigroup a => a -> a -> a
<> Key
"timestamp" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
t
forall a. Semigroup a => a -> a -> a
<> Key
"bits" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
b
forall a. Semigroup a => a -> a -> a
<> Key
"nonce" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
n
)
instance FromJSON BlockHeader where
parseJSON :: Value -> Parser BlockHeader
parseJSON =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BlockHeader" forall a b. (a -> b) -> a -> b
$ \Object
o ->
Word32
-> BlockHash
-> Hash256
-> Word32
-> Word32
-> Word32
-> BlockHeader
BlockHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prevblock"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Hash256
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"merkleroot")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bits"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nonce"
where
f :: Text -> Parser Hash256
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeHex)
instance Serial BlockHeader where
deserialize :: forall (m :: * -> *). MonadGet m => m BlockHeader
deserialize = do
Word32
v <- forall (m :: * -> *). MonadGet m => m Word32
getWord32le
BlockHash
p <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
Hash256
m <- forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
Word32
t <- forall (m :: * -> *). MonadGet m => m Word32
getWord32le
Word32
b <- forall (m :: * -> *). MonadGet m => m Word32
getWord32le
Word32
n <- forall (m :: * -> *). MonadGet m => m Word32
getWord32le
forall (m :: * -> *) a. Monad m => a -> m a
return
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 :: forall (m :: * -> *). MonadPut m => BlockHeader -> m ()
serialize (BlockHeader Word32
v BlockHash
p Hash256
m Word32
bt Word32
bb Word32
n) = do
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
v
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHash
p
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
m
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
bt
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
bb
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
n
instance Binary BlockHeader where
put :: BlockHeader -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get BlockHeader
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Serialize BlockHeader where
put :: Putter BlockHeader
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get BlockHeader
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
headerHash :: BlockHeader -> BlockHash
= Hash256 -> BlockHash
BlockHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
type BlockLocator = [BlockHash]
data GetBlocks = GetBlocks
{ GetBlocks -> Word32
getBlocksVersion :: !Word32
,
GetBlocks -> BlockLocator
getBlocksLocator :: !BlockLocator
,
GetBlocks -> BlockHash
getBlocksHashStop :: !BlockHash
}
deriving (GetBlocks -> GetBlocks -> Bool
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
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]
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetBlocks -> ()
$crnf :: GetBlocks -> ()
NFData)
instance Serial GetBlocks where
deserialize :: forall (m :: * -> *). MonadGet m => m GetBlocks
deserialize =
Word32 -> BlockLocator -> BlockHash -> GetBlocks
GetBlocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGet m => m Word32
getWord32le
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall {m :: * -> *} {a}. (Serial a, MonadGet m) => VarInt -> m [a]
repList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
where
repList :: VarInt -> m [a]
repList (VarInt Word64
c) = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
serialize :: forall (m :: * -> *). MonadPut m => GetBlocks -> m ()
serialize (GetBlocks Word32
v BlockLocator
xs BlockHash
h) = forall (m :: * -> *).
MonadPut m =>
Word32 -> BlockLocator -> BlockHash -> m ()
putGetBlockMsg Word32
v BlockLocator
xs BlockHash
h
instance Serialize GetBlocks where
put :: Putter GetBlocks
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get GetBlocks
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
putGetBlockMsg :: MonadPut m => Word32 -> BlockLocator -> BlockHash -> m ()
putGetBlockMsg :: forall (m :: * -> *).
MonadPut m =>
Word32 -> BlockLocator -> BlockHash -> m ()
putGetBlockMsg Word32
v BlockLocator
xs BlockHash
h = do
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
v
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length BlockLocator
xs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ BlockLocator
xs forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHash
h
data =
{ :: !Word32
,
:: !BlockLocator
,
:: !BlockHash
}
deriving (GetHeaders -> GetHeaders -> Bool
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
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]
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetHeaders -> ()
$crnf :: GetHeaders -> ()
NFData)
instance Serial GetHeaders where
deserialize :: forall (m :: * -> *). MonadGet m => m GetHeaders
deserialize =
Word32 -> BlockLocator -> BlockHash -> GetHeaders
GetHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGet m => m Word32
getWord32le
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall {m :: * -> *} {a}. (Serial a, MonadGet m) => VarInt -> m [a]
repList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
where
repList :: VarInt -> m [a]
repList (VarInt Word64
c) = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
serialize :: forall (m :: * -> *). MonadPut m => GetHeaders -> m ()
serialize (GetHeaders Word32
v BlockLocator
xs BlockHash
h) = forall (m :: * -> *).
MonadPut m =>
Word32 -> BlockLocator -> BlockHash -> m ()
putGetBlockMsg Word32
v BlockLocator
xs BlockHash
h
instance Serialize GetHeaders where
put :: Putter GetHeaders
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get GetHeaders
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Binary GetHeaders where
put :: GetHeaders -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get GetHeaders
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
type = (BlockHeader, VarInt)
newtype =
{
:: [BlockHeaderCount]
}
deriving (Headers -> Headers -> Bool
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
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]
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Headers -> ()
$crnf :: Headers -> ()
NFData)
instance Serial Headers where
deserialize :: forall (m :: * -> *). MonadGet m => m Headers
deserialize = [BlockHeaderCount] -> Headers
Headers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> m [BlockHeaderCount]
repList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)
where
repList :: VarInt -> m [BlockHeaderCount]
repList (VarInt Word64
c) = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m BlockHeaderCount
action
action :: m BlockHeaderCount
action = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
serialize :: forall (m :: * -> *). MonadPut m => Headers -> m ()
serialize (Headers [BlockHeaderCount]
xs) = do
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockHeaderCount]
xs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BlockHeaderCount]
xs forall a b. (a -> b) -> a -> b
$ \(BlockHeader
a, VarInt
b) -> forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHeader
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize VarInt
b
instance Serialize Headers where
put :: Putter Headers
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get Headers
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Binary Headers where
put :: Headers -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get Headers
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
decodeCompact ::
Word32 ->
(Integer, Bool)
decodeCompact :: Word32 -> (Integer, Bool)
decodeCompact Word32
nCompact = (if Bool
neg then Integer
res forall a. Num a => a -> a -> a
* (-Integer
1) else Integer
res, Bool
over)
where
nSize :: Int
nSize :: Int
nSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nCompact forall a. Bits a => a -> Int -> a
`shiftR` Int
24
nWord' :: Word32
nWord' :: Word32
nWord' = Word32
nCompact forall a. Bits a => a -> a -> a
.&. Word32
0x007fffff
nWord :: Word32
nWord :: Word32
nWord
| Int
nSize forall a. Ord a => a -> a -> Bool
<= Int
3 = Word32
nWord' forall a. Bits a => a -> Int -> a
`shiftR` (Int
8 forall a. Num a => a -> a -> a
* (Int
3 forall a. Num a => a -> a -> a
- Int
nSize))
| Bool
otherwise = Word32
nWord'
res :: Integer
res :: Integer
res
| Int
nSize forall a. Ord a => a -> a -> Bool
<= Int
3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nWord
| Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nWord forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 forall a. Num a => a -> a -> a
* (Int
nSize forall a. Num a => a -> a -> a
- Int
3))
neg :: Bool
neg = Word32
nWord forall a. Eq a => a -> a -> Bool
/= Word32
0 Bool -> Bool -> Bool
&& (Word32
nCompact forall a. Bits a => a -> a -> a
.&. Word32
0x00800000) forall a. Eq a => a -> a -> Bool
/= Word32
0
over :: Bool
over =
Word32
nWord forall a. Eq a => a -> a -> Bool
/= Word32
0
Bool -> Bool -> Bool
&& ( Int
nSize forall a. Ord a => a -> a -> Bool
> Int
34
Bool -> Bool -> Bool
|| Word32
nWord forall a. Ord a => a -> a -> Bool
> Word32
0xff Bool -> Bool -> Bool
&& Int
nSize forall a. Ord a => a -> a -> Bool
> Int
33
Bool -> Bool -> Bool
|| Word32
nWord forall a. Ord a => a -> a -> Bool
> Word32
0xffff Bool -> Bool -> Bool
&& Int
nSize forall a. Ord a => a -> a -> Bool
> Int
32
)
encodeCompact :: Integer -> Word32
encodeCompact :: Integer -> Word32
encodeCompact Integer
i = Word32
nCompact
where
i' :: Integer
i' = forall a. Num a => a -> a
abs Integer
i
neg :: Bool
neg = Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0
nSize' :: Int
nSize' :: Int
nSize' =
let f :: t -> a
f t
0 = a
0
f t
n = a
1 forall a. Num a => a -> a -> a
+ t -> a
f (t
n forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
in forall {t} {a}. (Num t, Num a, Bits t) => t -> a
f Integer
i'
nCompact''' :: Word32
nCompact''' :: Word32
nCompact'''
| Int
nSize' forall a. Ord a => a -> a -> Bool
<= Int
3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Integer
low64 forall a. Bits a => a -> a -> a
.&. Integer
i') forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 forall a. Num a => a -> a -> a
* (Int
3 forall a. Num a => a -> a -> a
- Int
nSize'))
| Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
low64 forall a. Bits a => a -> a -> a
.&. (Integer
i' forall a. Bits a => a -> Int -> a
`shiftR` (Int
8 forall a. Num a => a -> a -> a
* (Int
nSize' forall a. Num a => a -> a -> a
- Int
3)))
nCompact'' :: Word32
nSize :: Int
(Word32
nCompact'', Int
nSize)
| Word32
nCompact''' forall a. Bits a => a -> a -> a
.&. Word32
0x00800000 forall a. Eq a => a -> a -> Bool
/= Word32
0 = (Word32
nCompact''' forall a. Bits a => a -> Int -> a
`shiftR` Int
8, Int
nSize' forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = (Word32
nCompact''', Int
nSize')
nCompact' :: Word32
nCompact' :: Word32
nCompact' = Word32
nCompact'' forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nSize forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
nCompact :: Word32
nCompact :: Word32
nCompact
| Bool
neg Bool -> Bool -> Bool
&& (Word32
nCompact' forall a. Bits a => a -> a -> a
.&. Word32
0x007fffff forall a. Eq a => a -> a -> Bool
/= Word32
0) = Word32
nCompact' forall a. Bits a => a -> a -> a
.|. Word32
0x00800000
| Bool
otherwise = Word32
nCompact'
low64 :: Integer
low64 :: Integer
low64 = Integer
0xffffffffffffffff