{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE NoFieldSelectors #-}
module Haskoin.Network.Message
(
Message (..),
MessageHeader (..),
msgType,
putMessage,
getMessage,
)
where
import Control.DeepSeq
import Control.Monad (unless)
import Data.Binary (Binary (..))
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Serialize (Serialize (..))
import Data.Word (Word32)
import GHC.Generics (Generic)
import Haskoin.Block.Common
import Haskoin.Block.Merkle
import Haskoin.Crypto.Hash
import Haskoin.Network.Bloom
import Haskoin.Network.Common
import Haskoin.Network.Data
import Haskoin.Transaction.Common
data =
{
:: !Word32,
:: !MessageCommand,
:: !Word32,
:: !CheckSum32
}
deriving (MessageHeader -> MessageHeader -> Bool
(MessageHeader -> MessageHeader -> Bool)
-> (MessageHeader -> MessageHeader -> Bool) -> Eq MessageHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageHeader -> MessageHeader -> Bool
== :: MessageHeader -> MessageHeader -> Bool
$c/= :: MessageHeader -> MessageHeader -> Bool
/= :: MessageHeader -> MessageHeader -> Bool
Eq, Int -> MessageHeader -> ShowS
[MessageHeader] -> ShowS
MessageHeader -> String
(Int -> MessageHeader -> ShowS)
-> (MessageHeader -> String)
-> ([MessageHeader] -> ShowS)
-> Show MessageHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageHeader -> ShowS
showsPrec :: Int -> MessageHeader -> ShowS
$cshow :: MessageHeader -> String
show :: MessageHeader -> String
$cshowList :: [MessageHeader] -> ShowS
showList :: [MessageHeader] -> ShowS
Show, (forall x. MessageHeader -> Rep MessageHeader x)
-> (forall x. Rep MessageHeader x -> MessageHeader)
-> Generic MessageHeader
forall x. Rep MessageHeader x -> MessageHeader
forall x. MessageHeader -> Rep MessageHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageHeader -> Rep MessageHeader x
from :: forall x. MessageHeader -> Rep MessageHeader x
$cto :: forall x. Rep MessageHeader x -> MessageHeader
to :: forall x. Rep MessageHeader x -> MessageHeader
Generic, MessageHeader -> ()
(MessageHeader -> ()) -> NFData MessageHeader
forall a. (a -> ()) -> NFData a
$crnf :: MessageHeader -> ()
rnf :: MessageHeader -> ()
NFData)
instance Serial MessageHeader where
deserialize :: forall (m :: * -> *). MonadGet m => m MessageHeader
deserialize =
Word32 -> MessageCommand -> Word32 -> CheckSum32 -> MessageHeader
MessageHeader
(Word32 -> MessageCommand -> Word32 -> CheckSum32 -> MessageHeader)
-> m Word32
-> m (MessageCommand -> Word32 -> CheckSum32 -> MessageHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
m (MessageCommand -> Word32 -> CheckSum32 -> MessageHeader)
-> m MessageCommand -> m (Word32 -> CheckSum32 -> MessageHeader)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m MessageCommand
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m MessageCommand
deserialize
m (Word32 -> CheckSum32 -> MessageHeader)
-> m Word32 -> m (CheckSum32 -> MessageHeader)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
m (CheckSum32 -> MessageHeader) -> m CheckSum32 -> m MessageHeader
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m CheckSum32
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m CheckSum32
deserialize
serialize :: forall (m :: * -> *). MonadPut m => MessageHeader -> m ()
serialize (MessageHeader Word32
m MessageCommand
c Word32
l CheckSum32
chk) = do
Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
m
MessageCommand -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => MessageCommand -> m ()
serialize MessageCommand
c
Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
l
CheckSum32 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => CheckSum32 -> m ()
serialize CheckSum32
chk
instance Binary MessageHeader where
put :: MessageHeader -> Put
put = MessageHeader -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => MessageHeader -> m ()
serialize
get :: Get MessageHeader
get = Get MessageHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m MessageHeader
deserialize
instance Serialize MessageHeader where
put :: Putter MessageHeader
put = Putter MessageHeader
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => MessageHeader -> m ()
serialize
get :: Get MessageHeader
get = Get MessageHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m MessageHeader
deserialize
data Message
= MVersion !Version
| MVerAck
| MAddr !Addr
| MInv !Inv
| MGetData !GetData
| MNotFound !NotFound
| MGetBlocks !GetBlocks
| !GetHeaders
| MTx !Tx
| MBlock !Block
| MMerkleBlock !MerkleBlock
| !Headers
| MGetAddr
| MFilterLoad !FilterLoad
| MFilterAdd !FilterAdd
| MFilterClear
| MPing !Ping
| MPong !Pong
| MAlert !Alert
| MMempool
| MReject !Reject
|
| MOther !ByteString !ByteString
deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> String
show :: Message -> String
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show, (forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Message -> Rep Message x
from :: forall x. Message -> Rep Message x
$cto :: forall x. Rep Message x -> Message
to :: forall x. Rep Message x -> Message
Generic, Message -> ()
(Message -> ()) -> NFData Message
forall a. (a -> ()) -> NFData a
$crnf :: Message -> ()
rnf :: Message -> ()
NFData)
msgType :: Message -> MessageCommand
msgType :: Message -> MessageCommand
msgType (MVersion Version
_) = MessageCommand
MCVersion
msgType Message
MVerAck = MessageCommand
MCVerAck
msgType (MAddr Addr
_) = MessageCommand
MCAddr
msgType (MInv Inv
_) = MessageCommand
MCInv
msgType (MGetData GetData
_) = MessageCommand
MCGetData
msgType (MNotFound NotFound
_) = MessageCommand
MCNotFound
msgType (MGetBlocks GetBlocks
_) = MessageCommand
MCGetBlocks
msgType (MGetHeaders GetHeaders
_) = MessageCommand
MCGetHeaders
msgType (MTx Tx
_) = MessageCommand
MCTx
msgType (MBlock Block
_) = MessageCommand
MCBlock
msgType (MMerkleBlock MerkleBlock
_) = MessageCommand
MCMerkleBlock
msgType (MHeaders Headers
_) = MessageCommand
MCHeaders
msgType (MFilterLoad FilterLoad
_) = MessageCommand
MCFilterLoad
msgType (MFilterAdd FilterAdd
_) = MessageCommand
MCFilterAdd
msgType Message
MFilterClear = MessageCommand
MCFilterClear
msgType (MPing Ping
_) = MessageCommand
MCPing
msgType (MPong Pong
_) = MessageCommand
MCPong
msgType (MAlert Alert
_) = MessageCommand
MCAlert
msgType Message
MMempool = MessageCommand
MCMempool
msgType (MReject Reject
_) = MessageCommand
MCReject
msgType Message
MSendHeaders = MessageCommand
MCSendHeaders
msgType Message
MGetAddr = MessageCommand
MCGetAddr
msgType (MOther ByteString
c ByteString
_) = ByteString -> MessageCommand
MCOther ByteString
c
getMessage :: (MonadGet m) => Network -> m Message
getMessage :: forall (m :: * -> *). MonadGet m => Network -> m Message
getMessage Network
net = do
(MessageHeader Word32
mgc MessageCommand
cmd Word32
len CheckSum32
chk) <- m MessageHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m MessageHeader
deserialize
ByteString
bs <- m ByteString -> m ByteString
forall a. m a -> m a
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead (m ByteString -> m ByteString) -> m ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString (Int -> m ByteString) -> Int -> m ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(Word32
mgc Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Network
net.magic)
(String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"get: Invalid network magic bytes: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
mgc)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(ByteString -> CheckSum32
forall b. ByteArrayAccess b => b -> CheckSum32
checkSum32 ByteString
bs CheckSum32 -> CheckSum32 -> Bool
forall a. Eq a => a -> a -> Bool
== CheckSum32
chk)
(String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"get: Invalid message checksum: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CheckSum32 -> String
forall a. Show a => a -> String
show CheckSum32
chk)
if Word32
len Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
then do
ByteString
bs <- Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
ensure (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
let f :: Get Message
f = case MessageCommand
cmd of
MessageCommand
MCVersion -> Version -> Message
MVersion (Version -> Message) -> Get Version -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Version
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Version
deserialize
MessageCommand
MCAddr -> Addr -> Message
MAddr (Addr -> Message) -> Get Addr -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Addr
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Addr
deserialize
MessageCommand
MCInv -> Inv -> Message
MInv (Inv -> Message) -> Get Inv -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Inv
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Inv
deserialize
MessageCommand
MCGetData -> GetData -> Message
MGetData (GetData -> Message) -> Get GetData -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get GetData
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m GetData
deserialize
MessageCommand
MCNotFound -> NotFound -> Message
MNotFound (NotFound -> Message) -> Get NotFound -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get NotFound
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m NotFound
deserialize
MessageCommand
MCGetBlocks -> GetBlocks -> Message
MGetBlocks (GetBlocks -> Message) -> Get GetBlocks -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get GetBlocks
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m GetBlocks
deserialize
MessageCommand
MCGetHeaders -> GetHeaders -> Message
MGetHeaders (GetHeaders -> Message) -> Get GetHeaders -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get GetHeaders
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m GetHeaders
deserialize
MessageCommand
MCTx -> Tx -> Message
MTx (Tx -> Message) -> Get Tx -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Tx
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Tx
deserialize
MessageCommand
MCBlock -> Block -> Message
MBlock (Block -> Message) -> Get Block -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Block
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Block
deserialize
MessageCommand
MCMerkleBlock -> MerkleBlock -> Message
MMerkleBlock (MerkleBlock -> Message) -> Get MerkleBlock -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MerkleBlock
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m MerkleBlock
deserialize
MessageCommand
MCHeaders -> Headers -> Message
MHeaders (Headers -> Message) -> Get Headers -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Headers
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Headers
deserialize
MessageCommand
MCFilterLoad -> FilterLoad -> Message
MFilterLoad (FilterLoad -> Message) -> Get FilterLoad -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get FilterLoad
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m FilterLoad
deserialize
MessageCommand
MCFilterAdd -> FilterAdd -> Message
MFilterAdd (FilterAdd -> Message) -> Get FilterAdd -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get FilterAdd
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m FilterAdd
deserialize
MessageCommand
MCPing -> Ping -> Message
MPing (Ping -> Message) -> Get Ping -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Ping
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Ping
deserialize
MessageCommand
MCPong -> Pong -> Message
MPong (Pong -> Message) -> Get Pong -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Pong
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Pong
deserialize
MessageCommand
MCAlert -> Alert -> Message
MAlert (Alert -> Message) -> Get Alert -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Alert
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Alert
deserialize
MessageCommand
MCReject -> Reject -> Message
MReject (Reject -> Message) -> Get Reject -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Reject
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Reject
deserialize
MCOther ByteString
c -> ByteString -> ByteString -> Message
MOther ByteString
c (ByteString -> Message) -> Get ByteString -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
MessageCommand
_ ->
String -> Get Message
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Message) -> String -> Get Message
forall a b. (a -> b) -> a -> b
$
String
"get: command "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ MessageCommand -> String
forall a. Show a => a -> String
show MessageCommand
cmd
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" should not carry a payload"
(String -> m Message)
-> (Message -> m Message) -> Either String Message -> m Message
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m Message
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Message -> m Message
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Get Message -> ByteString -> Either String Message
forall a. Get a -> ByteString -> Either String a
runGetS Get Message
f ByteString
bs)
else case MessageCommand
cmd of
MessageCommand
MCGetAddr -> Message -> m Message
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MGetAddr
MessageCommand
MCVerAck -> Message -> m Message
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MVerAck
MessageCommand
MCFilterClear -> Message -> m Message
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MFilterClear
MessageCommand
MCMempool -> Message -> m Message
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MMempool
MessageCommand
MCSendHeaders -> Message -> m Message
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MSendHeaders
MCOther ByteString
c -> Message -> m Message
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> Message
MOther ByteString
c ByteString
B.empty)
MessageCommand
_ ->
String -> m Message
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Message) -> String -> m Message
forall a b. (a -> b) -> a -> b
$
String
"get: command "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ MessageCommand -> String
forall a. Show a => a -> String
show MessageCommand
cmd
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is expected to carry a payload"
putMessage :: (MonadPut m) => Network -> Message -> m ()
putMessage :: forall (m :: * -> *). MonadPut m => Network -> Message -> m ()
putMessage Network
net Message
msg = do
let (MessageCommand
cmd, ByteString
payload) =
case Message
msg of
MVersion Version
m -> (MessageCommand
MCVersion, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Version -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Version -> m ()
serialize Version
m)
Message
MVerAck -> (MessageCommand
MCVerAck, ByteString
B.empty)
MAddr Addr
m -> (MessageCommand
MCAddr, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Addr -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Addr -> m ()
serialize Addr
m)
MInv Inv
m -> (MessageCommand
MCInv, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Inv -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Inv -> m ()
serialize Inv
m)
MGetData GetData
m -> (MessageCommand
MCGetData, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ GetData -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => GetData -> m ()
serialize GetData
m)
MNotFound NotFound
m -> (MessageCommand
MCNotFound, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ NotFound -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => NotFound -> m ()
serialize NotFound
m)
MGetBlocks GetBlocks
m -> (MessageCommand
MCGetBlocks, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ GetBlocks -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => GetBlocks -> m ()
serialize GetBlocks
m)
MGetHeaders GetHeaders
m -> (MessageCommand
MCGetHeaders, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ GetHeaders -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => GetHeaders -> m ()
serialize GetHeaders
m)
MTx Tx
m -> (MessageCommand
MCTx, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
serialize Tx
m)
MBlock Block
m -> (MessageCommand
MCBlock, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Block -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Block -> m ()
serialize Block
m)
MMerkleBlock MerkleBlock
m -> (MessageCommand
MCMerkleBlock, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ MerkleBlock -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => MerkleBlock -> m ()
serialize MerkleBlock
m)
MHeaders Headers
m -> (MessageCommand
MCHeaders, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Headers -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Headers -> m ()
serialize Headers
m)
Message
MGetAddr -> (MessageCommand
MCGetAddr, ByteString
B.empty)
MFilterLoad FilterLoad
m -> (MessageCommand
MCFilterLoad, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ FilterLoad -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => FilterLoad -> m ()
serialize FilterLoad
m)
MFilterAdd FilterAdd
m -> (MessageCommand
MCFilterAdd, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ FilterAdd -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => FilterAdd -> m ()
serialize FilterAdd
m)
Message
MFilterClear -> (MessageCommand
MCFilterClear, ByteString
B.empty)
MPing Ping
m -> (MessageCommand
MCPing, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Ping -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Ping -> m ()
serialize Ping
m)
MPong Pong
m -> (MessageCommand
MCPong, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Pong -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Pong -> m ()
serialize Pong
m)
MAlert Alert
m -> (MessageCommand
MCAlert, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Alert -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Alert -> m ()
serialize Alert
m)
Message
MMempool -> (MessageCommand
MCMempool, ByteString
B.empty)
MReject Reject
m -> (MessageCommand
MCReject, Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Reject -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Reject -> m ()
serialize Reject
m)
Message
MSendHeaders -> (MessageCommand
MCSendHeaders, ByteString
B.empty)
MOther ByteString
c ByteString
p -> (ByteString -> MessageCommand
MCOther ByteString
c, ByteString
p)
chk :: CheckSum32
chk = ByteString -> CheckSum32
forall b. ByteArrayAccess b => b -> CheckSum32
checkSum32 ByteString
payload
len :: Word32
len = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
payload
header :: MessageHeader
header = Word32 -> MessageCommand -> Word32 -> CheckSum32 -> MessageHeader
MessageHeader Network
net.magic MessageCommand
cmd Word32
len CheckSum32
chk
MessageHeader -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => MessageHeader -> m ()
serialize MessageHeader
header
ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
payload