{-# 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.Crypto.Hash
import Haskoin.Data
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 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 ()
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 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

-- | Deserializer for network messages.
getMessage :: MonadGet m => Network -> m Message
getMessage :: 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
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
$ 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 (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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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 (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 (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
            MessageCommand
MCGetAddr -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MGetAddr
            MessageCommand
MCVerAck -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MVerAck
            MessageCommand
MCFilterClear -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MFilterClear
            MessageCommand
MCMempool -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MMempool
            MessageCommand
MCSendHeaders -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
MSendHeaders
            MCOther ByteString
c -> Message -> m Message
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> Message
MOther ByteString
c ByteString
BS.empty)
            MessageCommand
_ ->
                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
$
                    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"

-- | Serializer for network messages.
putMessage :: MonadPut m => Network -> Message -> m ()
putMessage :: 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 ()
serialize Version
m)
                Message
MVerAck -> (MessageCommand
MCVerAck, ByteString
BS.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 ()
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 ()
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 ()
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 ()
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 ()
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 ()
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 ()
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 ()
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 ()
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 ()
serialize Headers
m)
                Message
MGetAddr -> (MessageCommand
MCGetAddr, ByteString
BS.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 ()
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 ()
serialize FilterAdd
m)
                Message
MFilterClear -> (MessageCommand
MCFilterClear, ByteString
BS.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 ()
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 ()
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 ()
serialize Alert
m)
                Message
MMempool -> (MessageCommand
MCMempool, ByteString
BS.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 ()
serialize Reject
m)
                Message
MSendHeaders -> (MessageCommand
MCSendHeaders, ByteString
BS.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
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