{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric  #-}
{-|
Module      : Haskoin.Network.Message
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX

Peer-to-peer network message serialization.
-}
module Haskoin.Network.Message
    ( -- * Network Message
      Message(..)
    , MessageHeader(..)
    , msgType
    , putMessage
    , getMessage
    ) where

import           Control.DeepSeq
import           Control.Monad              (unless)
import           Data.Binary                (Binary (..))
import           Data.ByteString            (ByteString)
import qualified Data.ByteString            as BS
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.Constants
import           Haskoin.Crypto.Hash
import           Haskoin.Network.Bloom
import           Haskoin.Network.Common
import           Haskoin.Transaction.Common

-- | Data type representing the header of a 'Message'. All messages sent between
-- nodes contain a message header.
data MessageHeader = MessageHeader
    { -- | magic bytes identify network
      MessageHeader -> Word32
headMagic       :: !Word32
      -- | message type
    , MessageHeader -> MessageCommand
headCmd         :: !MessageCommand
      -- | length of payload
    , MessageHeader -> Word32
headPayloadSize :: !Word32
      -- | checksum of payload
    , MessageHeader -> CheckSum32
headChecksum    :: !CheckSum32
    } deriving (MessageHeader -> MessageHeader -> Bool
(MessageHeader -> MessageHeader -> Bool)
-> (MessageHeader -> MessageHeader -> Bool) -> Eq MessageHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageHeader -> MessageHeader -> Bool
$c/= :: MessageHeader -> MessageHeader -> Bool
== :: MessageHeader -> MessageHeader -> Bool
$c== :: 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
showList :: [MessageHeader] -> ShowS
$cshowList :: [MessageHeader] -> ShowS
show :: MessageHeader -> String
$cshow :: MessageHeader -> String
showsPrec :: Int -> MessageHeader -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep MessageHeader x -> MessageHeader
$cfrom :: forall x. MessageHeader -> Rep MessageHeader x
Generic, MessageHeader -> ()
(MessageHeader -> ()) -> NFData MessageHeader
forall a. (a -> ()) -> NFData a
rnf :: MessageHeader -> ()
$crnf :: MessageHeader -> ()
NFData)

instance Serial MessageHeader where

    deserialize :: 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m MessageCommand
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        m (Word32 -> CheckSum32 -> MessageHeader)
-> m Word32 -> m (CheckSum32 -> MessageHeader)
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m CheckSum32
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

    serialize :: MessageHeader -> m ()
serialize (MessageHeader m :: Word32
m c :: MessageCommand
c l :: Word32
l chk :: 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 ()
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 ()
serialize   CheckSum32
chk

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

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

-- | The 'Message' type is used to identify all the valid messages that can be
-- sent between bitcoin peers. Only values of type 'Message' will be accepted
-- by other bitcoin peers as bitcoin protocol messages need to be correctly
-- serialized with message headers. Serializing a 'Message' value will
-- include the 'MessageHeader' with the correct checksum value automatically.
-- No need to add the 'MessageHeader' separately.
data Message
    = MVersion !Version
    | MVerAck
    | MAddr !Addr
    | MInv !Inv
    | MGetData !GetData
    | MNotFound !NotFound
    | MGetBlocks !GetBlocks
    | MGetHeaders !GetHeaders
    | MTx !Tx
    | MBlock !Block
    | MMerkleBlock !MerkleBlock
    | MHeaders !Headers
    | MGetAddr
    | MFilterLoad !FilterLoad
    | MFilterAdd !FilterAdd
    | MFilterClear
    | MPing !Ping
    | MPong !Pong
    | MAlert !Alert
    | MMempool
    | MReject !Reject
    | MSendHeaders
    | 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
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: 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
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Message x -> Message
$cfrom :: forall x. Message -> Rep Message x
Generic, Message -> ()
(Message -> ()) -> NFData Message
forall a. (a -> ()) -> NFData a
rnf :: Message -> ()
$crnf :: Message -> ()
NFData)

-- | Get 'MessageCommand' assocated with a message.
msgType :: Message -> MessageCommand
msgType :: Message -> MessageCommand
msgType (MVersion _)     = MessageCommand
MCVersion
msgType MVerAck          = MessageCommand
MCVerAck
msgType (MAddr _)        = MessageCommand
MCAddr
msgType (MInv _)         = MessageCommand
MCInv
msgType (MGetData _)     = MessageCommand
MCGetData
msgType (MNotFound _)    = MessageCommand
MCNotFound
msgType (MGetBlocks _)   = MessageCommand
MCGetBlocks
msgType (MGetHeaders _)  = MessageCommand
MCGetHeaders
msgType (MTx _)          = MessageCommand
MCTx
msgType (MBlock _)       = MessageCommand
MCBlock
msgType (MMerkleBlock _) = MessageCommand
MCMerkleBlock
msgType (MHeaders _)     = MessageCommand
MCHeaders

msgType (MFilterLoad _)  = MessageCommand
MCFilterLoad
msgType (MFilterAdd _)   = MessageCommand
MCFilterAdd
msgType MFilterClear     = MessageCommand
MCFilterClear
msgType (MPing _)        = MessageCommand
MCPing
msgType (MPong _)        = MessageCommand
MCPong
msgType (MAlert _)       = MessageCommand
MCAlert
msgType MMempool         = MessageCommand
MCMempool
msgType (MReject _)      = MessageCommand
MCReject
msgType MSendHeaders     = MessageCommand
MCSendHeaders
msgType MGetAddr         = MessageCommand
MCGetAddr
msgType (MOther c :: ByteString
c _)     = ByteString -> MessageCommand
MCOther ByteString
c

-- | Deserializer for network messages.
getMessage :: MonadGet m => Network -> m Message
getMessage :: Network -> m Message
getMessage net :: Network
net = do
    (MessageHeader mgc :: Word32
mgc cmd :: MessageCommand
cmd len :: Word32
len chk :: CheckSum32
chk) <- m MessageHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    ByteString
bs <- m ByteString -> m ByteString
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 -> Word32
getNetworkMagic Network
net)
        (String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "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 (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "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
> 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
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     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
deserialize
                     MCOther c :: 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)
                     _             -> String -> Get Message
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Message) -> String -> Get Message
forall a b. (a -> b) -> a -> b
$ "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]
++
                                            " 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 (m :: * -> *) a. MonadFail m => String -> m a
fail Message -> m Message
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
                 MCGetAddr     -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MGetAddr
                 MCVerAck      -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MVerAck
                 MCFilterClear -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MFilterClear
                 MCMempool     -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MMempool
                 MCSendHeaders -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MSendHeaders
                 MCOther c :: ByteString
c     -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> Message
MOther ByteString
c ByteString
BS.empty)
                 _             -> String -> m Message
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Message) -> String -> m Message
forall a b. (a -> b) -> a -> b
$ "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]
++
                                         " is expected to carry a payload"

-- | Serializer for network messages.
putMessage :: MonadPut m => Network -> Message -> m ()
putMessage :: Network -> Message -> m ()
putMessage net :: Network
net msg :: Message
msg = do
    let (cmd :: MessageCommand
cmd, payload :: ByteString
payload) =
            case Message
msg of
            MVersion m :: 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 ()
serialize Version
m)
            MVerAck        -> (MessageCommand
MCVerAck, ByteString
BS.empty)
            MAddr m :: 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 ()
serialize Addr
m)
            MInv m :: 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 ()
serialize Inv
m)
            MGetData m :: 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 ()
serialize GetData
m)
            MNotFound m :: 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 ()
serialize NotFound
m)
            MGetBlocks m :: 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 ()
serialize GetBlocks
m)
            MGetHeaders m :: 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 ()
serialize GetHeaders
m)
            MTx m :: 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 ()
serialize Tx
m)
            MBlock m :: 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 ()
serialize Block
m)
            MMerkleBlock m :: 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 ()
serialize MerkleBlock
m)
            MHeaders m :: 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 ()
serialize Headers
m)
            MGetAddr       -> (MessageCommand
MCGetAddr, ByteString
BS.empty)
            MFilterLoad m :: 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 ()
serialize FilterLoad
m)
            MFilterAdd m :: 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 ()
serialize FilterAdd
m)
            MFilterClear   -> (MessageCommand
MCFilterClear, ByteString
BS.empty)
            MPing m :: 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 ()
serialize Ping
m)
            MPong m :: 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 ()
serialize Pong
m)
            MAlert m :: 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 ()
serialize Alert
m)
            MMempool       -> (MessageCommand
MCMempool, ByteString
BS.empty)
            MReject m :: 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 ()
serialize Reject
m)
            MSendHeaders   -> (MessageCommand
MCSendHeaders, ByteString
BS.empty)
            MOther c :: ByteString
c p :: 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
BS.length ByteString
payload
        header :: MessageHeader
header = Word32 -> MessageCommand -> Word32 -> CheckSum32 -> MessageHeader
MessageHeader (Network -> Word32
getNetworkMagic Network
net) MessageCommand
cmd Word32
len CheckSum32
chk
    MessageHeader -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize MessageHeader
header
    ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
payload