{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- 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 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 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
magic :: !Word32,
    -- | message type
    MessageHeader -> MessageCommand
cmd :: !MessageCommand,
    -- | length of payload
    MessageHeader -> Word32
size :: !Word32,
    -- | checksum of payload
    MessageHeader -> CheckSum32
checksum :: !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

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

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

-- | Serializer for network messages.
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