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

Common functions and data types related to peer-to-peer network.
-}
module Haskoin.Network.Common
    ( -- * Network Data Types
      Addr(..)
    , NetworkAddressTime
    , Alert(..)
    , GetData(..)
    , Inv(..)
    , InvVector(..)
    , InvType(..)
    , HostAddress
    , hostToSockAddr
    , sockToHostAddress
    , NetworkAddress(..)
    , NotFound(..)
    , Ping(..)
    , Pong(..)
    , Reject(..)
    , RejectCode(..)
    , VarInt(..)
    , VarString(..)
    , Version(..)
    , MessageCommand(..)
    , reject
    , nodeNone
    , nodeNetwork
    , nodeGetUTXO
    , nodeBloom
    , nodeWitness
    , nodeXThin
    , commandToString
    , stringToCommand
    , putVarInt
    ) where

import           Control.DeepSeq
import           Control.Monad           (forM_, liftM2, replicateM, unless)
import           Data.Binary             (Binary (..))
import           Data.Bits               (shiftL)
import           Data.ByteString         (ByteString)
import qualified Data.ByteString         as B
import           Data.ByteString.Char8   as C (replicate)
import           Data.Bytes.Get
import           Data.Bytes.Put
import           Data.Bytes.Serial
import           Data.Serialize          (Serialize (..))
import           Data.String
import           Data.String.Conversions (cs)
import           Data.Word               (Word32, Word64)
import           GHC.Generics            (Generic)
import           Haskoin.Crypto.Hash
import           Network.Socket          (SockAddr (..))
import           Text.Read               as R

-- | Network address with a timestamp.
type NetworkAddressTime = (Word32, NetworkAddress)

-- | Provides information about known nodes in the bitcoin network. An 'Addr'
-- type is sent inside a 'Message' as a response to a 'GetAddr' message.
newtype Addr =
    Addr { -- List of addresses of other nodes on the network with timestamps.
           Addr -> [NetworkAddressTime]
addrList :: [NetworkAddressTime]
         }
    deriving (Addr -> Addr -> Bool
(Addr -> Addr -> Bool) -> (Addr -> Addr -> Bool) -> Eq Addr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c== :: Addr -> Addr -> Bool
Eq, Int -> Addr -> ShowS
[Addr] -> ShowS
Addr -> String
(Int -> Addr -> ShowS)
-> (Addr -> String) -> ([Addr] -> ShowS) -> Show Addr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Addr] -> ShowS
$cshowList :: [Addr] -> ShowS
show :: Addr -> String
$cshow :: Addr -> String
showsPrec :: Int -> Addr -> ShowS
$cshowsPrec :: Int -> Addr -> ShowS
Show, (forall x. Addr -> Rep Addr x)
-> (forall x. Rep Addr x -> Addr) -> Generic Addr
forall x. Rep Addr x -> Addr
forall x. Addr -> Rep Addr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Addr x -> Addr
$cfrom :: forall x. Addr -> Rep Addr x
Generic, Addr -> ()
(Addr -> ()) -> NFData Addr
forall a. (a -> ()) -> NFData a
rnf :: Addr -> ()
$crnf :: Addr -> ()
NFData)

instance Serial Addr where

    deserialize :: m Addr
deserialize = [NetworkAddressTime] -> Addr
Addr ([NetworkAddressTime] -> Addr) -> m [NetworkAddressTime] -> m Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> m [NetworkAddressTime]
repList (VarInt -> m [NetworkAddressTime])
-> m VarInt -> m [NetworkAddressTime]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)
      where
        repList :: VarInt -> m [NetworkAddressTime]
repList (VarInt c :: Word64
c) = Int -> m NetworkAddressTime -> m [NetworkAddressTime]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m NetworkAddressTime
action
        action :: m NetworkAddressTime
action             = (Word32 -> NetworkAddress -> NetworkAddressTime)
-> m Word32 -> m NetworkAddress -> m NetworkAddressTime
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le m NetworkAddress
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

    serialize :: Addr -> m ()
serialize (Addr xs :: [NetworkAddressTime]
xs) = do
        Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [NetworkAddressTime] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NetworkAddressTime]
xs
        [NetworkAddressTime] -> (NetworkAddressTime -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [NetworkAddressTime]
xs ((NetworkAddressTime -> m ()) -> m ())
-> (NetworkAddressTime -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(a :: Word32
a,b :: NetworkAddress
b) -> Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NetworkAddress -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize NetworkAddress
b

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

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

-- | Data type describing signed messages that can be sent between bitcoin
-- nodes to display important notifications to end users about the health of
-- the network.
data Alert =
    Alert {
          -- | Alert payload.
            Alert -> VarString
alertPayload   :: !VarString
          -- | ECDSA signature of the payload
          , Alert -> VarString
alertSignature :: !VarString
          } deriving (Alert -> Alert -> Bool
(Alert -> Alert -> Bool) -> (Alert -> Alert -> Bool) -> Eq Alert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alert -> Alert -> Bool
$c/= :: Alert -> Alert -> Bool
== :: Alert -> Alert -> Bool
$c== :: Alert -> Alert -> Bool
Eq, Int -> Alert -> ShowS
[Alert] -> ShowS
Alert -> String
(Int -> Alert -> ShowS)
-> (Alert -> String) -> ([Alert] -> ShowS) -> Show Alert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alert] -> ShowS
$cshowList :: [Alert] -> ShowS
show :: Alert -> String
$cshow :: Alert -> String
showsPrec :: Int -> Alert -> ShowS
$cshowsPrec :: Int -> Alert -> ShowS
Show, ReadPrec [Alert]
ReadPrec Alert
Int -> ReadS Alert
ReadS [Alert]
(Int -> ReadS Alert)
-> ReadS [Alert]
-> ReadPrec Alert
-> ReadPrec [Alert]
-> Read Alert
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Alert]
$creadListPrec :: ReadPrec [Alert]
readPrec :: ReadPrec Alert
$creadPrec :: ReadPrec Alert
readList :: ReadS [Alert]
$creadList :: ReadS [Alert]
readsPrec :: Int -> ReadS Alert
$creadsPrec :: Int -> ReadS Alert
Read, (forall x. Alert -> Rep Alert x)
-> (forall x. Rep Alert x -> Alert) -> Generic Alert
forall x. Rep Alert x -> Alert
forall x. Alert -> Rep Alert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Alert x -> Alert
$cfrom :: forall x. Alert -> Rep Alert x
Generic, Alert -> ()
(Alert -> ()) -> NFData Alert
forall a. (a -> ()) -> NFData a
rnf :: Alert -> ()
$crnf :: Alert -> ()
NFData)

instance Serial Alert where
    deserialize :: m Alert
deserialize = VarString -> VarString -> Alert
Alert (VarString -> VarString -> Alert)
-> m VarString -> m (VarString -> Alert)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m VarString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m (VarString -> Alert) -> m VarString -> m Alert
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m VarString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    serialize :: Alert -> m ()
serialize (Alert p :: VarString
p s :: VarString
s) = VarString -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize VarString
p m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VarString -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize VarString
s

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

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

-- | The 'GetData' type is used to retrieve information on a specific object
-- ('Block' or 'Tx') identified by the objects hash. The payload of a 'GetData'
-- request is a list of 'InvVector' which represent all the hashes of objects
-- that a node wants. The response to a 'GetBlock' message will be either a
-- 'Block' or a 'Tx' message depending on the type of the object referenced by
-- the hash. Usually, 'GetData' messages are sent after a node receives an 'Inv'
-- message that contains unknown object hashes.
newtype GetData =
    GetData { -- | list of object hashes
              GetData -> [InvVector]
getDataList :: [InvVector]
            } deriving (GetData -> GetData -> Bool
(GetData -> GetData -> Bool)
-> (GetData -> GetData -> Bool) -> Eq GetData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetData -> GetData -> Bool
$c/= :: GetData -> GetData -> Bool
== :: GetData -> GetData -> Bool
$c== :: GetData -> GetData -> Bool
Eq, Int -> GetData -> ShowS
[GetData] -> ShowS
GetData -> String
(Int -> GetData -> ShowS)
-> (GetData -> String) -> ([GetData] -> ShowS) -> Show GetData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetData] -> ShowS
$cshowList :: [GetData] -> ShowS
show :: GetData -> String
$cshow :: GetData -> String
showsPrec :: Int -> GetData -> ShowS
$cshowsPrec :: Int -> GetData -> ShowS
Show, (forall x. GetData -> Rep GetData x)
-> (forall x. Rep GetData x -> GetData) -> Generic GetData
forall x. Rep GetData x -> GetData
forall x. GetData -> Rep GetData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetData x -> GetData
$cfrom :: forall x. GetData -> Rep GetData x
Generic, GetData -> ()
(GetData -> ()) -> NFData GetData
forall a. (a -> ()) -> NFData a
rnf :: GetData -> ()
$crnf :: GetData -> ()
NFData)

instance Serial GetData where

    deserialize :: m GetData
deserialize = [InvVector] -> GetData
GetData ([InvVector] -> GetData) -> m [InvVector] -> m GetData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> m [InvVector]
forall (m :: * -> *) a. (Serial a, MonadGet m) => VarInt -> m [a]
repList (VarInt -> m [InvVector]) -> m VarInt -> m [InvVector]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)
      where
        repList :: VarInt -> m [a]
repList (VarInt c :: Word64
c) = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

    serialize :: GetData -> m ()
serialize (GetData xs :: [InvVector]
xs) = do
        Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [InvVector] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InvVector]
xs
        [InvVector] -> (InvVector -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [InvVector]
xs InvVector -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

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

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

-- | 'Inv' messages are used by nodes to advertise their knowledge of new
-- objects by publishing a list of hashes to a peer. 'Inv' messages can be sent
-- unsolicited or in response to a 'GetBlocks' message.
newtype Inv =
    Inv {
        -- | inventory
          Inv -> [InvVector]
invList :: [InvVector]
        } deriving (Inv -> Inv -> Bool
(Inv -> Inv -> Bool) -> (Inv -> Inv -> Bool) -> Eq Inv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inv -> Inv -> Bool
$c/= :: Inv -> Inv -> Bool
== :: Inv -> Inv -> Bool
$c== :: Inv -> Inv -> Bool
Eq, Int -> Inv -> ShowS
[Inv] -> ShowS
Inv -> String
(Int -> Inv -> ShowS)
-> (Inv -> String) -> ([Inv] -> ShowS) -> Show Inv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inv] -> ShowS
$cshowList :: [Inv] -> ShowS
show :: Inv -> String
$cshow :: Inv -> String
showsPrec :: Int -> Inv -> ShowS
$cshowsPrec :: Int -> Inv -> ShowS
Show, (forall x. Inv -> Rep Inv x)
-> (forall x. Rep Inv x -> Inv) -> Generic Inv
forall x. Rep Inv x -> Inv
forall x. Inv -> Rep Inv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Inv x -> Inv
$cfrom :: forall x. Inv -> Rep Inv x
Generic, Inv -> ()
(Inv -> ()) -> NFData Inv
forall a. (a -> ()) -> NFData a
rnf :: Inv -> ()
$crnf :: Inv -> ()
NFData)

instance Serial Inv where

    deserialize :: m Inv
deserialize = [InvVector] -> Inv
Inv ([InvVector] -> Inv) -> m [InvVector] -> m Inv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> m [InvVector]
forall (m :: * -> *) a. (Serial a, MonadGet m) => VarInt -> m [a]
repList (VarInt -> m [InvVector]) -> m VarInt -> m [InvVector]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)
      where
        repList :: VarInt -> m [a]
repList (VarInt c :: Word64
c) = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

    serialize :: Inv -> m ()
serialize (Inv xs :: [InvVector]
xs) = do
        Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [InvVector] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InvVector]
xs
        [InvVector] -> (InvVector -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [InvVector]
xs InvVector -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

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

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

-- | Data type identifying the type of an inventory vector. SegWit types are
-- only used in 'GetData' messages, not 'Inv'.
data InvType
    = InvError -- ^ error
    | InvTx -- ^ transaction
    | InvBlock -- ^ block
    | InvMerkleBlock -- ^ filtered block
    | InvWitnessTx -- ^ segwit transaction
    | InvWitnessBlock -- ^ segwit block
    | InvWitnessMerkleBlock -- ^ segwit filtered block
    | InvType Word32 -- ^ unknown inv type
    deriving (InvType -> InvType -> Bool
(InvType -> InvType -> Bool)
-> (InvType -> InvType -> Bool) -> Eq InvType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvType -> InvType -> Bool
$c/= :: InvType -> InvType -> Bool
== :: InvType -> InvType -> Bool
$c== :: InvType -> InvType -> Bool
Eq, Int -> InvType -> ShowS
[InvType] -> ShowS
InvType -> String
(Int -> InvType -> ShowS)
-> (InvType -> String) -> ([InvType] -> ShowS) -> Show InvType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvType] -> ShowS
$cshowList :: [InvType] -> ShowS
show :: InvType -> String
$cshow :: InvType -> String
showsPrec :: Int -> InvType -> ShowS
$cshowsPrec :: Int -> InvType -> ShowS
Show, ReadPrec [InvType]
ReadPrec InvType
Int -> ReadS InvType
ReadS [InvType]
(Int -> ReadS InvType)
-> ReadS [InvType]
-> ReadPrec InvType
-> ReadPrec [InvType]
-> Read InvType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InvType]
$creadListPrec :: ReadPrec [InvType]
readPrec :: ReadPrec InvType
$creadPrec :: ReadPrec InvType
readList :: ReadS [InvType]
$creadList :: ReadS [InvType]
readsPrec :: Int -> ReadS InvType
$creadsPrec :: Int -> ReadS InvType
Read, (forall x. InvType -> Rep InvType x)
-> (forall x. Rep InvType x -> InvType) -> Generic InvType
forall x. Rep InvType x -> InvType
forall x. InvType -> Rep InvType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InvType x -> InvType
$cfrom :: forall x. InvType -> Rep InvType x
Generic, InvType -> ()
(InvType -> ()) -> NFData InvType
forall a. (a -> ()) -> NFData a
rnf :: InvType -> ()
$crnf :: InvType -> ()
NFData)

instance Serial InvType where
    deserialize :: m InvType
deserialize = Word32 -> m InvType
forall (m :: * -> *). Monad m => Word32 -> m InvType
go (Word32 -> m InvType) -> m Word32 -> m InvType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
      where
        go :: Word32 -> m InvType
go x :: Word32
x =
            case Word32
x of
                0 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvError
                1 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvTx
                2 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvBlock
                3 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvMerkleBlock
                _
                    | Word32
x Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 30 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvWitnessTx
                    | Word32
x Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 30 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 2 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvWitnessBlock
                    | Word32
x Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 30 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 3 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvWitnessMerkleBlock
                    | Bool
otherwise -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> InvType
InvType Word32
x)
    serialize :: InvType -> m ()
serialize x :: InvType
x =
        Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Word32 -> m ()) -> Word32 -> m ()
forall a b. (a -> b) -> a -> b
$
        case InvType
x of
            InvError              -> 0
            InvTx                 -> 1
            InvBlock              -> 2
            InvMerkleBlock        -> 3
            InvWitnessTx          -> 1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 30 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1
            InvWitnessBlock       -> 1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 30 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 2
            InvWitnessMerkleBlock -> 1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` 30 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 3
            InvType w :: Word32
w             -> Word32
w

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

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

-- | Invectory vectors represent hashes identifying objects such as a 'Block' or
-- a 'Tx'. They notify other peers about new data or data they have otherwise
-- requested.
data InvVector =
    InvVector {
                -- | type of object
                InvVector -> InvType
invType :: !InvType
                -- | 256-bit hash of object
              , InvVector -> Hash256
invHash :: !Hash256
              } deriving (InvVector -> InvVector -> Bool
(InvVector -> InvVector -> Bool)
-> (InvVector -> InvVector -> Bool) -> Eq InvVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvVector -> InvVector -> Bool
$c/= :: InvVector -> InvVector -> Bool
== :: InvVector -> InvVector -> Bool
$c== :: InvVector -> InvVector -> Bool
Eq, Int -> InvVector -> ShowS
[InvVector] -> ShowS
InvVector -> String
(Int -> InvVector -> ShowS)
-> (InvVector -> String)
-> ([InvVector] -> ShowS)
-> Show InvVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvVector] -> ShowS
$cshowList :: [InvVector] -> ShowS
show :: InvVector -> String
$cshow :: InvVector -> String
showsPrec :: Int -> InvVector -> ShowS
$cshowsPrec :: Int -> InvVector -> ShowS
Show, (forall x. InvVector -> Rep InvVector x)
-> (forall x. Rep InvVector x -> InvVector) -> Generic InvVector
forall x. Rep InvVector x -> InvVector
forall x. InvVector -> Rep InvVector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InvVector x -> InvVector
$cfrom :: forall x. InvVector -> Rep InvVector x
Generic, InvVector -> ()
(InvVector -> ()) -> NFData InvVector
forall a. (a -> ()) -> NFData a
rnf :: InvVector -> ()
$crnf :: InvVector -> ()
NFData)

instance Serial InvVector where
    deserialize :: m InvVector
deserialize = InvType -> Hash256 -> InvVector
InvVector (InvType -> Hash256 -> InvVector)
-> m InvType -> m (Hash256 -> InvVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InvType
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m (Hash256 -> InvVector) -> m Hash256 -> m InvVector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    serialize :: InvVector -> m ()
serialize (InvVector t :: InvType
t h :: Hash256
h) = InvType -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize InvType
t m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Hash256 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
h

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

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

newtype HostAddress =
    HostAddress ByteString
    deriving (HostAddress -> HostAddress -> Bool
(HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool) -> Eq HostAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostAddress -> HostAddress -> Bool
$c/= :: HostAddress -> HostAddress -> Bool
== :: HostAddress -> HostAddress -> Bool
$c== :: HostAddress -> HostAddress -> Bool
Eq, Int -> HostAddress -> ShowS
[HostAddress] -> ShowS
HostAddress -> String
(Int -> HostAddress -> ShowS)
-> (HostAddress -> String)
-> ([HostAddress] -> ShowS)
-> Show HostAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostAddress] -> ShowS
$cshowList :: [HostAddress] -> ShowS
show :: HostAddress -> String
$cshow :: HostAddress -> String
showsPrec :: Int -> HostAddress -> ShowS
$cshowsPrec :: Int -> HostAddress -> ShowS
Show, Eq HostAddress
Eq HostAddress =>
(HostAddress -> HostAddress -> Ordering)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> HostAddress)
-> (HostAddress -> HostAddress -> HostAddress)
-> Ord HostAddress
HostAddress -> HostAddress -> Bool
HostAddress -> HostAddress -> Ordering
HostAddress -> HostAddress -> HostAddress
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HostAddress -> HostAddress -> HostAddress
$cmin :: HostAddress -> HostAddress -> HostAddress
max :: HostAddress -> HostAddress -> HostAddress
$cmax :: HostAddress -> HostAddress -> HostAddress
>= :: HostAddress -> HostAddress -> Bool
$c>= :: HostAddress -> HostAddress -> Bool
> :: HostAddress -> HostAddress -> Bool
$c> :: HostAddress -> HostAddress -> Bool
<= :: HostAddress -> HostAddress -> Bool
$c<= :: HostAddress -> HostAddress -> Bool
< :: HostAddress -> HostAddress -> Bool
$c< :: HostAddress -> HostAddress -> Bool
compare :: HostAddress -> HostAddress -> Ordering
$ccompare :: HostAddress -> HostAddress -> Ordering
$cp1Ord :: Eq HostAddress
Ord, (forall x. HostAddress -> Rep HostAddress x)
-> (forall x. Rep HostAddress x -> HostAddress)
-> Generic HostAddress
forall x. Rep HostAddress x -> HostAddress
forall x. HostAddress -> Rep HostAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HostAddress x -> HostAddress
$cfrom :: forall x. HostAddress -> Rep HostAddress x
Generic, HostAddress -> ()
(HostAddress -> ()) -> NFData HostAddress
forall a. (a -> ()) -> NFData a
rnf :: HostAddress -> ()
$crnf :: HostAddress -> ()
NFData)

instance Serial HostAddress where
    serialize :: HostAddress -> m ()
serialize (HostAddress bs :: ByteString
bs) = ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
bs
    deserialize :: m HostAddress
deserialize = ByteString -> HostAddress
HostAddress (ByteString -> HostAddress) -> m ByteString -> m HostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString 18

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

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

-- | Data type describing a bitcoin network address. Addresses are stored in
-- IPv6 format. IPv4 addresses are mapped to IPv6 using IPv4 mapped IPv6
-- addresses: <http://en.wikipedia.org/wiki/IPv6#IPv4-mapped_IPv6_addresses>.
data NetworkAddress =
    NetworkAddress { -- | bitmask of services available for this address
                     NetworkAddress -> Word64
naServices :: !Word64
                     -- | address and port information
                   , NetworkAddress -> HostAddress
naAddress  :: !HostAddress
                   } deriving (NetworkAddress -> NetworkAddress -> Bool
(NetworkAddress -> NetworkAddress -> Bool)
-> (NetworkAddress -> NetworkAddress -> Bool) -> Eq NetworkAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkAddress -> NetworkAddress -> Bool
$c/= :: NetworkAddress -> NetworkAddress -> Bool
== :: NetworkAddress -> NetworkAddress -> Bool
$c== :: NetworkAddress -> NetworkAddress -> Bool
Eq, Int -> NetworkAddress -> ShowS
[NetworkAddress] -> ShowS
NetworkAddress -> String
(Int -> NetworkAddress -> ShowS)
-> (NetworkAddress -> String)
-> ([NetworkAddress] -> ShowS)
-> Show NetworkAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkAddress] -> ShowS
$cshowList :: [NetworkAddress] -> ShowS
show :: NetworkAddress -> String
$cshow :: NetworkAddress -> String
showsPrec :: Int -> NetworkAddress -> ShowS
$cshowsPrec :: Int -> NetworkAddress -> ShowS
Show, (forall x. NetworkAddress -> Rep NetworkAddress x)
-> (forall x. Rep NetworkAddress x -> NetworkAddress)
-> Generic NetworkAddress
forall x. Rep NetworkAddress x -> NetworkAddress
forall x. NetworkAddress -> Rep NetworkAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NetworkAddress x -> NetworkAddress
$cfrom :: forall x. NetworkAddress -> Rep NetworkAddress x
Generic, NetworkAddress -> ()
(NetworkAddress -> ()) -> NFData NetworkAddress
forall a. (a -> ()) -> NFData a
rnf :: NetworkAddress -> ()
$crnf :: NetworkAddress -> ()
NFData)

hostToSockAddr :: HostAddress -> SockAddr
hostToSockAddr :: HostAddress -> SockAddr
hostToSockAddr (HostAddress bs :: ByteString
bs) =
    case Get SockAddr -> ByteString -> Either String SockAddr
forall a. Get a -> ByteString -> Either String a
runGetS Get SockAddr
forall (m :: * -> *). MonadGet m => m SockAddr
getSockAddr ByteString
bs of
        Left e :: String
e  -> String -> SockAddr
forall a. HasCallStack => String -> a
error String
e
        Right x :: SockAddr
x -> SockAddr
x

sockToHostAddress :: SockAddr -> HostAddress
sockToHostAddress :: SockAddr -> HostAddress
sockToHostAddress = ByteString -> HostAddress
HostAddress (ByteString -> HostAddress)
-> (SockAddr -> ByteString) -> SockAddr -> HostAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> (SockAddr -> Put) -> SockAddr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SockAddr -> Put
forall (m :: * -> *). MonadPut m => SockAddr -> m ()
putSockAddr

putSockAddr :: MonadPut m => SockAddr -> m ()
putSockAddr :: SockAddr -> m ()
putSockAddr (SockAddrInet6 p :: PortNumber
p _ (a :: Word32
a, b :: Word32
b, c :: Word32
c, d :: Word32
d) _) = do
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
a
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
b
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
c
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
d
    Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16be (PortNumber -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
p)

putSockAddr (SockAddrInet p :: PortNumber
p a :: Word32
a) = do
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be 0x00000000
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be 0x00000000
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be 0x0000ffff
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32host Word32
a
    Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16be (PortNumber -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
p)

putSockAddr _ = String -> m ()
forall a. HasCallStack => String -> a
error "Invalid address type"

getSockAddr :: MonadGet m => m SockAddr
getSockAddr :: m SockAddr
getSockAddr = do
    Word32
a <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
    Word32
b <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
    Word32
c <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
    if Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x00000000 Bool -> Bool -> Bool
&& Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x00000000 Bool -> Bool -> Bool
&& Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x0000ffff
        then do
            Word32
d <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32host
            Word16
p <- m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be
            SockAddr -> m SockAddr
forall (m :: * -> *) a. Monad m => a -> m a
return (SockAddr -> m SockAddr) -> SockAddr -> m SockAddr
forall a b. (a -> b) -> a -> b
$ PortNumber -> Word32 -> SockAddr
SockAddrInet (Word16 -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
p) Word32
d
        else do
            Word32
d <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
            Word16
p <- m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be
            SockAddr -> m SockAddr
forall (m :: * -> *) a. Monad m => a -> m a
return (SockAddr -> m SockAddr) -> SockAddr -> m SockAddr
forall a b. (a -> b) -> a -> b
$ PortNumber -> Word32 -> HostAddress6 -> Word32 -> SockAddr
SockAddrInet6 (Word16 -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
p) 0 (Word32
a, Word32
b, Word32
c, Word32
d) 0

instance Serial NetworkAddress where
    deserialize :: m NetworkAddress
deserialize = Word64 -> HostAddress -> NetworkAddress
NetworkAddress (Word64 -> HostAddress -> NetworkAddress)
-> m Word64 -> m (HostAddress -> NetworkAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le m (HostAddress -> NetworkAddress)
-> m HostAddress -> m NetworkAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m HostAddress
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    serialize :: NetworkAddress -> m ()
serialize (NetworkAddress s :: Word64
s a :: HostAddress
a) = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le Word64
s m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HostAddress -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize HostAddress
a

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

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

-- | A 'NotFound' message is returned as a response to a 'GetData' message
-- whe one of the requested objects could not be retrieved. This could happen,
-- for example, if a tranasaction was requested and was not available in the
-- memory pool of the receiving node.
newtype NotFound =
    NotFound { -- | Inventory vectors related to this request
               NotFound -> [InvVector]
notFoundList :: [InvVector]
             } deriving (NotFound -> NotFound -> Bool
(NotFound -> NotFound -> Bool)
-> (NotFound -> NotFound -> Bool) -> Eq NotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotFound -> NotFound -> Bool
$c/= :: NotFound -> NotFound -> Bool
== :: NotFound -> NotFound -> Bool
$c== :: NotFound -> NotFound -> Bool
Eq, Int -> NotFound -> ShowS
[NotFound] -> ShowS
NotFound -> String
(Int -> NotFound -> ShowS)
-> (NotFound -> String) -> ([NotFound] -> ShowS) -> Show NotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotFound] -> ShowS
$cshowList :: [NotFound] -> ShowS
show :: NotFound -> String
$cshow :: NotFound -> String
showsPrec :: Int -> NotFound -> ShowS
$cshowsPrec :: Int -> NotFound -> ShowS
Show, (forall x. NotFound -> Rep NotFound x)
-> (forall x. Rep NotFound x -> NotFound) -> Generic NotFound
forall x. Rep NotFound x -> NotFound
forall x. NotFound -> Rep NotFound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotFound x -> NotFound
$cfrom :: forall x. NotFound -> Rep NotFound x
Generic, NotFound -> ()
(NotFound -> ()) -> NFData NotFound
forall a. (a -> ()) -> NFData a
rnf :: NotFound -> ()
$crnf :: NotFound -> ()
NFData)

instance Serial NotFound where

    deserialize :: m NotFound
deserialize = [InvVector] -> NotFound
NotFound ([InvVector] -> NotFound) -> m [InvVector] -> m NotFound
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> m [InvVector]
forall (m :: * -> *) a. (Serial a, MonadGet m) => VarInt -> m [a]
repList (VarInt -> m [InvVector]) -> m VarInt -> m [InvVector]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)
      where
        repList :: VarInt -> m [a]
repList (VarInt c :: Word64
c) = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
c) m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

    serialize :: NotFound -> m ()
serialize (NotFound xs :: [InvVector]
xs) = do
        Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ [InvVector] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InvVector]
xs
        [InvVector] -> (InvVector -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [InvVector]
xs InvVector -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize

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

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

-- | A 'Ping' message is sent to bitcoin peers to check if a connection is still
-- open.
newtype Ping =
    Ping { -- | A random nonce used to identify the recipient of the ping
           -- request once a Pong response is received.
           Ping -> Word64
pingNonce :: Word64
         } deriving (Ping -> Ping -> Bool
(Ping -> Ping -> Bool) -> (Ping -> Ping -> Bool) -> Eq Ping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ping -> Ping -> Bool
$c/= :: Ping -> Ping -> Bool
== :: Ping -> Ping -> Bool
$c== :: Ping -> Ping -> Bool
Eq, Int -> Ping -> ShowS
[Ping] -> ShowS
Ping -> String
(Int -> Ping -> ShowS)
-> (Ping -> String) -> ([Ping] -> ShowS) -> Show Ping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ping] -> ShowS
$cshowList :: [Ping] -> ShowS
show :: Ping -> String
$cshow :: Ping -> String
showsPrec :: Int -> Ping -> ShowS
$cshowsPrec :: Int -> Ping -> ShowS
Show, ReadPrec [Ping]
ReadPrec Ping
Int -> ReadS Ping
ReadS [Ping]
(Int -> ReadS Ping)
-> ReadS [Ping] -> ReadPrec Ping -> ReadPrec [Ping] -> Read Ping
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ping]
$creadListPrec :: ReadPrec [Ping]
readPrec :: ReadPrec Ping
$creadPrec :: ReadPrec Ping
readList :: ReadS [Ping]
$creadList :: ReadS [Ping]
readsPrec :: Int -> ReadS Ping
$creadsPrec :: Int -> ReadS Ping
Read, (forall x. Ping -> Rep Ping x)
-> (forall x. Rep Ping x -> Ping) -> Generic Ping
forall x. Rep Ping x -> Ping
forall x. Ping -> Rep Ping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ping x -> Ping
$cfrom :: forall x. Ping -> Rep Ping x
Generic, Ping -> ()
(Ping -> ()) -> NFData Ping
forall a. (a -> ()) -> NFData a
rnf :: Ping -> ()
$crnf :: Ping -> ()
NFData)

-- | A Pong message is sent as a response to a ping message.
newtype Pong =
    Pong {
           -- | nonce from corresponding 'Ping'
           Pong -> Word64
pongNonce :: Word64
         } deriving (Pong -> Pong -> Bool
(Pong -> Pong -> Bool) -> (Pong -> Pong -> Bool) -> Eq Pong
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pong -> Pong -> Bool
$c/= :: Pong -> Pong -> Bool
== :: Pong -> Pong -> Bool
$c== :: Pong -> Pong -> Bool
Eq, Int -> Pong -> ShowS
[Pong] -> ShowS
Pong -> String
(Int -> Pong -> ShowS)
-> (Pong -> String) -> ([Pong] -> ShowS) -> Show Pong
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pong] -> ShowS
$cshowList :: [Pong] -> ShowS
show :: Pong -> String
$cshow :: Pong -> String
showsPrec :: Int -> Pong -> ShowS
$cshowsPrec :: Int -> Pong -> ShowS
Show, ReadPrec [Pong]
ReadPrec Pong
Int -> ReadS Pong
ReadS [Pong]
(Int -> ReadS Pong)
-> ReadS [Pong] -> ReadPrec Pong -> ReadPrec [Pong] -> Read Pong
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pong]
$creadListPrec :: ReadPrec [Pong]
readPrec :: ReadPrec Pong
$creadPrec :: ReadPrec Pong
readList :: ReadS [Pong]
$creadList :: ReadS [Pong]
readsPrec :: Int -> ReadS Pong
$creadsPrec :: Int -> ReadS Pong
Read, (forall x. Pong -> Rep Pong x)
-> (forall x. Rep Pong x -> Pong) -> Generic Pong
forall x. Rep Pong x -> Pong
forall x. Pong -> Rep Pong x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pong x -> Pong
$cfrom :: forall x. Pong -> Rep Pong x
Generic, Pong -> ()
(Pong -> ()) -> NFData Pong
forall a. (a -> ()) -> NFData a
rnf :: Pong -> ()
$crnf :: Pong -> ()
NFData)

instance Serial Ping where
    deserialize :: m Ping
deserialize = Word64 -> Ping
Ping (Word64 -> Ping) -> m Word64 -> m Ping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le
    serialize :: Ping -> m ()
serialize (Ping n :: Word64
n) = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le Word64
n

instance Serial Pong where
    deserialize :: m Pong
deserialize = Word64 -> Pong
Pong (Word64 -> Pong) -> m Word64 -> m Pong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le
    serialize :: Pong -> m ()
serialize (Pong n :: Word64
n) = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le Word64
n

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

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

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

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

-- | The 'Reject' message is sent when messages are rejected by a peer.
data Reject =
    Reject {
             -- | type of message rejected
             Reject -> MessageCommand
rejectMessage :: !MessageCommand
             -- | rejection code
           , Reject -> RejectCode
rejectCode    :: !RejectCode
             -- | text reason for rejection
           , Reject -> VarString
rejectReason  :: !VarString
             -- | extra data such as block or tx hash
           , Reject -> ByteString
rejectData    :: !ByteString
           } deriving (Reject -> Reject -> Bool
(Reject -> Reject -> Bool)
-> (Reject -> Reject -> Bool) -> Eq Reject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reject -> Reject -> Bool
$c/= :: Reject -> Reject -> Bool
== :: Reject -> Reject -> Bool
$c== :: Reject -> Reject -> Bool
Eq, Int -> Reject -> ShowS
[Reject] -> ShowS
Reject -> String
(Int -> Reject -> ShowS)
-> (Reject -> String) -> ([Reject] -> ShowS) -> Show Reject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reject] -> ShowS
$cshowList :: [Reject] -> ShowS
show :: Reject -> String
$cshow :: Reject -> String
showsPrec :: Int -> Reject -> ShowS
$cshowsPrec :: Int -> Reject -> ShowS
Show, ReadPrec [Reject]
ReadPrec Reject
Int -> ReadS Reject
ReadS [Reject]
(Int -> ReadS Reject)
-> ReadS [Reject]
-> ReadPrec Reject
-> ReadPrec [Reject]
-> Read Reject
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Reject]
$creadListPrec :: ReadPrec [Reject]
readPrec :: ReadPrec Reject
$creadPrec :: ReadPrec Reject
readList :: ReadS [Reject]
$creadList :: ReadS [Reject]
readsPrec :: Int -> ReadS Reject
$creadsPrec :: Int -> ReadS Reject
Read, (forall x. Reject -> Rep Reject x)
-> (forall x. Rep Reject x -> Reject) -> Generic Reject
forall x. Rep Reject x -> Reject
forall x. Reject -> Rep Reject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Reject x -> Reject
$cfrom :: forall x. Reject -> Rep Reject x
Generic, Reject -> ()
(Reject -> ()) -> NFData Reject
forall a. (a -> ()) -> NFData a
rnf :: Reject -> ()
$crnf :: Reject -> ()
NFData)

-- | Rejection code associated to the 'Reject' message.
data RejectCode
    = RejectMalformed
    | RejectInvalid
    | RejectObsolete
    | RejectDuplicate
    | RejectNonStandard
    | RejectDust
    | RejectInsufficientFee
    | RejectCheckpoint
    deriving (RejectCode -> RejectCode -> Bool
(RejectCode -> RejectCode -> Bool)
-> (RejectCode -> RejectCode -> Bool) -> Eq RejectCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RejectCode -> RejectCode -> Bool
$c/= :: RejectCode -> RejectCode -> Bool
== :: RejectCode -> RejectCode -> Bool
$c== :: RejectCode -> RejectCode -> Bool
Eq, Int -> RejectCode -> ShowS
[RejectCode] -> ShowS
RejectCode -> String
(Int -> RejectCode -> ShowS)
-> (RejectCode -> String)
-> ([RejectCode] -> ShowS)
-> Show RejectCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RejectCode] -> ShowS
$cshowList :: [RejectCode] -> ShowS
show :: RejectCode -> String
$cshow :: RejectCode -> String
showsPrec :: Int -> RejectCode -> ShowS
$cshowsPrec :: Int -> RejectCode -> ShowS
Show, ReadPrec [RejectCode]
ReadPrec RejectCode
Int -> ReadS RejectCode
ReadS [RejectCode]
(Int -> ReadS RejectCode)
-> ReadS [RejectCode]
-> ReadPrec RejectCode
-> ReadPrec [RejectCode]
-> Read RejectCode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RejectCode]
$creadListPrec :: ReadPrec [RejectCode]
readPrec :: ReadPrec RejectCode
$creadPrec :: ReadPrec RejectCode
readList :: ReadS [RejectCode]
$creadList :: ReadS [RejectCode]
readsPrec :: Int -> ReadS RejectCode
$creadsPrec :: Int -> ReadS RejectCode
Read, (forall x. RejectCode -> Rep RejectCode x)
-> (forall x. Rep RejectCode x -> RejectCode) -> Generic RejectCode
forall x. Rep RejectCode x -> RejectCode
forall x. RejectCode -> Rep RejectCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RejectCode x -> RejectCode
$cfrom :: forall x. RejectCode -> Rep RejectCode x
Generic, RejectCode -> ()
(RejectCode -> ()) -> NFData RejectCode
forall a. (a -> ()) -> NFData a
rnf :: RejectCode -> ()
$crnf :: RejectCode -> ()
NFData)

instance Serial RejectCode where

    deserialize :: m RejectCode
deserialize =
        m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m RejectCode) -> m RejectCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \code :: Word8
code -> case Word8
code of
        0x01 -> RejectCode -> m RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectMalformed
        0x10 -> RejectCode -> m RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectInvalid
        0x11 -> RejectCode -> m RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectObsolete
        0x12 -> RejectCode -> m RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectDuplicate
        0x40 -> RejectCode -> m RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectNonStandard
        0x41 -> RejectCode -> m RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectDust
        0x42 -> RejectCode -> m RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectInsufficientFee
        0x43 -> RejectCode -> m RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectCheckpoint
        _    -> String -> m RejectCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m RejectCode) -> String -> m RejectCode
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
                [ "Reject get: Invalid code"
                , Word8 -> String
forall a. Show a => a -> String
show Word8
code
                ]

    serialize :: RejectCode -> m ()
serialize code :: RejectCode
code = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ case RejectCode
code of
        RejectMalformed       -> 0x01
        RejectInvalid         -> 0x10
        RejectObsolete        -> 0x11
        RejectDuplicate       -> 0x12
        RejectNonStandard     -> 0x40
        RejectDust            -> 0x41
        RejectInsufficientFee -> 0x42
        RejectCheckpoint      -> 0x43

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

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

-- | Convenience function to build a 'Reject' message.
reject :: MessageCommand -> RejectCode -> ByteString -> Reject
reject :: MessageCommand -> RejectCode -> ByteString -> Reject
reject cmd :: MessageCommand
cmd code :: RejectCode
code reason :: ByteString
reason =
    MessageCommand -> RejectCode -> VarString -> ByteString -> Reject
Reject MessageCommand
cmd RejectCode
code (ByteString -> VarString
VarString ByteString
reason) ByteString
B.empty

instance Serial Reject where
    deserialize :: m Reject
deserialize =
        m VarString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m VarString -> (VarString -> m Reject) -> m Reject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(VarString bs :: ByteString
bs) ->
            MessageCommand -> RejectCode -> VarString -> ByteString -> Reject
Reject (ByteString -> MessageCommand
stringToCommand ByteString
bs)
            (RejectCode -> VarString -> ByteString -> Reject)
-> m RejectCode -> m (VarString -> ByteString -> Reject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RejectCode
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            m (VarString -> ByteString -> Reject)
-> m VarString -> m (ByteString -> Reject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m VarString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            m (ByteString -> Reject) -> m ByteString -> m Reject
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ByteString
maybeData
      where
        maybeData :: m ByteString
maybeData =
            m Bool
forall (m :: * -> *). MonadGet m => m Bool
isEmpty m Bool -> (Bool -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \done :: Bool
done ->
                if Bool
done
                    then ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
                    else Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString 32
    serialize :: Reject -> m ()
serialize (Reject cmd :: MessageCommand
cmd code :: RejectCode
code reason :: VarString
reason dat :: ByteString
dat) = do
        VarString -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (VarString -> m ()) -> VarString -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> VarString
VarString (ByteString -> VarString) -> ByteString -> VarString
forall a b. (a -> b) -> a -> b
$ MessageCommand -> ByteString
commandToString MessageCommand
cmd
        RejectCode -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize RejectCode
code
        VarString -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize VarString
reason
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
dat) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
dat

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

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

-- | Data type representing a variable-length integer. The 'VarInt' type
-- usually precedes an array or a string that can vary in length.
newtype VarInt = VarInt { VarInt -> Word64
getVarInt :: Word64 }
    deriving (VarInt -> VarInt -> Bool
(VarInt -> VarInt -> Bool)
-> (VarInt -> VarInt -> Bool) -> Eq VarInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarInt -> VarInt -> Bool
$c/= :: VarInt -> VarInt -> Bool
== :: VarInt -> VarInt -> Bool
$c== :: VarInt -> VarInt -> Bool
Eq, Int -> VarInt -> ShowS
[VarInt] -> ShowS
VarInt -> String
(Int -> VarInt -> ShowS)
-> (VarInt -> String) -> ([VarInt] -> ShowS) -> Show VarInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarInt] -> ShowS
$cshowList :: [VarInt] -> ShowS
show :: VarInt -> String
$cshow :: VarInt -> String
showsPrec :: Int -> VarInt -> ShowS
$cshowsPrec :: Int -> VarInt -> ShowS
Show, ReadPrec [VarInt]
ReadPrec VarInt
Int -> ReadS VarInt
ReadS [VarInt]
(Int -> ReadS VarInt)
-> ReadS [VarInt]
-> ReadPrec VarInt
-> ReadPrec [VarInt]
-> Read VarInt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VarInt]
$creadListPrec :: ReadPrec [VarInt]
readPrec :: ReadPrec VarInt
$creadPrec :: ReadPrec VarInt
readList :: ReadS [VarInt]
$creadList :: ReadS [VarInt]
readsPrec :: Int -> ReadS VarInt
$creadsPrec :: Int -> ReadS VarInt
Read, (forall x. VarInt -> Rep VarInt x)
-> (forall x. Rep VarInt x -> VarInt) -> Generic VarInt
forall x. Rep VarInt x -> VarInt
forall x. VarInt -> Rep VarInt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VarInt x -> VarInt
$cfrom :: forall x. VarInt -> Rep VarInt x
Generic, VarInt -> ()
(VarInt -> ()) -> NFData VarInt
forall a. (a -> ()) -> NFData a
rnf :: VarInt -> ()
$crnf :: VarInt -> ()
NFData)

instance Serial VarInt where

    deserialize :: m VarInt
deserialize = Word64 -> VarInt
VarInt (Word64 -> VarInt) -> m Word64 -> m VarInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m Word64) -> m Word64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> m Word64
forall (m :: * -> *) a. (MonadGet m, Integral a) => a -> m Word64
go )
      where
        go :: a -> m Word64
go 0xff = m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le
        go 0xfe = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> m Word32 -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
        go 0xfd = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word64) -> m Word16 -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16le
        go x :: a
x    = Word64 -> m Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> m Word64) -> Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x

    serialize :: VarInt -> m ()
serialize (VarInt x :: Word64
x)
        | Word64
x Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< 0xfd =
            Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x
        | Word64
x Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xffff = do
            Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0xfd
            Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16le (Word16 -> m ()) -> Word16 -> m ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x
        | Word64
x Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xffffffff = do
            Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0xfe
            Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le (Word32 -> m ()) -> Word32 -> m ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x
        | Bool
otherwise = do
            Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0xff
            Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le Word64
x

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

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

putVarInt :: (MonadPut m, Integral a) => a -> m ()
putVarInt :: a -> m ()
putVarInt = VarInt -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (VarInt -> m ()) -> (a -> VarInt) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VarInt
VarInt (Word64 -> VarInt) -> (a -> Word64) -> a -> VarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Data type for serialization of variable-length strings.
newtype VarString = VarString { VarString -> ByteString
getVarString :: ByteString }
    deriving (VarString -> VarString -> Bool
(VarString -> VarString -> Bool)
-> (VarString -> VarString -> Bool) -> Eq VarString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarString -> VarString -> Bool
$c/= :: VarString -> VarString -> Bool
== :: VarString -> VarString -> Bool
$c== :: VarString -> VarString -> Bool
Eq, Int -> VarString -> ShowS
[VarString] -> ShowS
VarString -> String
(Int -> VarString -> ShowS)
-> (VarString -> String)
-> ([VarString] -> ShowS)
-> Show VarString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarString] -> ShowS
$cshowList :: [VarString] -> ShowS
show :: VarString -> String
$cshow :: VarString -> String
showsPrec :: Int -> VarString -> ShowS
$cshowsPrec :: Int -> VarString -> ShowS
Show, ReadPrec [VarString]
ReadPrec VarString
Int -> ReadS VarString
ReadS [VarString]
(Int -> ReadS VarString)
-> ReadS [VarString]
-> ReadPrec VarString
-> ReadPrec [VarString]
-> Read VarString
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VarString]
$creadListPrec :: ReadPrec [VarString]
readPrec :: ReadPrec VarString
$creadPrec :: ReadPrec VarString
readList :: ReadS [VarString]
$creadList :: ReadS [VarString]
readsPrec :: Int -> ReadS VarString
$creadsPrec :: Int -> ReadS VarString
Read, (forall x. VarString -> Rep VarString x)
-> (forall x. Rep VarString x -> VarString) -> Generic VarString
forall x. Rep VarString x -> VarString
forall x. VarString -> Rep VarString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VarString x -> VarString
$cfrom :: forall x. VarString -> Rep VarString x
Generic, VarString -> ()
(VarString -> ()) -> NFData VarString
forall a. (a -> ()) -> NFData a
rnf :: VarString -> ()
$crnf :: VarString -> ()
NFData)

instance Serial VarString where

    deserialize :: m VarString
deserialize = ByteString -> VarString
VarString (ByteString -> VarString) -> m ByteString -> m VarString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> m ByteString
forall (m :: * -> *). MonadGet m => VarInt -> m ByteString
readBS (VarInt -> m ByteString) -> m VarInt -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m VarInt
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)
      where
        readBS :: VarInt -> m ByteString
readBS (VarInt len :: Word64
len) = Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len)

    serialize :: VarString -> m ()
serialize (VarString bs :: ByteString
bs) = do
        Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString ByteString
bs

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

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

-- | When a bitcoin node creates an outgoing connection to another node,
-- the first message it will send is a 'Version' message. The other node
-- will similarly respond with it's own 'Version' message.
data Version =
    Version {
              -- | protocol version
              Version -> Word32
version     :: !Word32
              -- | features supported by this connection
            , Version -> Word64
services    :: !Word64
              -- | unix timestamp
            , Version -> Word64
timestamp   :: !Word64
              -- | network address of remote node
            , Version -> NetworkAddress
addrRecv    :: !NetworkAddress
              -- | network address of sending node
            , Version -> NetworkAddress
addrSend    :: !NetworkAddress
              -- | random nonce to detect connection to self
            , Version -> Word64
verNonce    :: !Word64
              -- | user agent string
            , Version -> VarString
userAgent   :: !VarString
              -- | height of the last block in sending node
            , Version -> Word32
startHeight :: !Word32
              -- | relay transactions flag (BIP-37)
            , Version -> Bool
relay       :: !Bool
            } deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic, Version -> ()
(Version -> ()) -> NFData Version
forall a. (a -> ()) -> NFData a
rnf :: Version -> ()
$crnf :: Version -> ()
NFData)

instance Serial Version where

    deserialize :: m Version
deserialize = Word32
-> Word64
-> Word64
-> NetworkAddress
-> NetworkAddress
-> Word64
-> VarString
-> Word32
-> Bool
-> Version
Version (Word32
 -> Word64
 -> Word64
 -> NetworkAddress
 -> NetworkAddress
 -> Word64
 -> VarString
 -> Word32
 -> Bool
 -> Version)
-> m Word32
-> m (Word64
      -> Word64
      -> NetworkAddress
      -> NetworkAddress
      -> Word64
      -> VarString
      -> Word32
      -> Bool
      -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
                          m (Word64
   -> Word64
   -> NetworkAddress
   -> NetworkAddress
   -> Word64
   -> VarString
   -> Word32
   -> Bool
   -> Version)
-> m Word64
-> m (Word64
      -> NetworkAddress
      -> NetworkAddress
      -> Word64
      -> VarString
      -> Word32
      -> Bool
      -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le
                          m (Word64
   -> NetworkAddress
   -> NetworkAddress
   -> Word64
   -> VarString
   -> Word32
   -> Bool
   -> Version)
-> m Word64
-> m (NetworkAddress
      -> NetworkAddress
      -> Word64
      -> VarString
      -> Word32
      -> Bool
      -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le
                          m (NetworkAddress
   -> NetworkAddress
   -> Word64
   -> VarString
   -> Word32
   -> Bool
   -> Version)
-> m NetworkAddress
-> m (NetworkAddress
      -> Word64 -> VarString -> Word32 -> Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m NetworkAddress
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
                          m (NetworkAddress
   -> Word64 -> VarString -> Word32 -> Bool -> Version)
-> m NetworkAddress
-> m (Word64 -> VarString -> Word32 -> Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m NetworkAddress
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
                          m (Word64 -> VarString -> Word32 -> Bool -> Version)
-> m Word64 -> m (VarString -> Word32 -> Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64le
                          m (VarString -> Word32 -> Bool -> Version)
-> m VarString -> m (Word32 -> Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m VarString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
                          m (Word32 -> Bool -> Version) -> m Word32 -> m (Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32le
                          m (Bool -> Version) -> m Bool -> m Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> m Bool
forall (m :: * -> *). MonadGet m => Bool -> m Bool
go (Bool -> m Bool) -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Bool
forall (m :: * -> *). MonadGet m => m Bool
isEmpty)
      where
        go :: Bool -> m Bool
go True  = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        go False = m Bool
forall (m :: * -> *). MonadGet m => m Bool
getBool

    serialize :: Version -> m ()
serialize (Version v :: Word32
v s :: Word64
s t :: Word64
t ar :: NetworkAddress
ar as :: NetworkAddress
as n :: Word64
n ua :: VarString
ua sh :: Word32
sh r :: Bool
r) = do
        Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
v
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le Word64
s
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le Word64
t
        NetworkAddress -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize   NetworkAddress
ar
        NetworkAddress -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize   NetworkAddress
as
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64le Word64
n
        VarString -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize   VarString
ua
        Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32le Word32
sh
        Bool -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
putBool     Bool
r

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

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

-- | 0x00 is 'False', anything else is 'True'.
getBool :: MonadGet m => m Bool
getBool :: m Bool
getBool = Word8 -> m Bool
forall a (m :: * -> *). (Eq a, Num a, Monad m) => a -> m Bool
go (Word8 -> m Bool) -> m Word8 -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
  where
    go :: a -> m Bool
go 0 = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    go _ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

putBool :: MonadPut m => Bool -> m ()
putBool :: Bool -> m ()
putBool True  = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 1
putBool False = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0

-- | A 'MessageCommand' is included in a 'MessageHeader' in order to identify
-- the type of message present in the payload. This allows the message
-- de-serialization code to know how to decode a particular message payload.
-- Every valid 'Message' constructor has a corresponding 'MessageCommand'
-- constructor.
data MessageCommand
    = MCVersion
    | MCVerAck
    | MCAddr
    | MCInv
    | MCGetData
    | MCNotFound
    | MCGetBlocks
    | MCGetHeaders
    | MCTx
    | MCBlock
    | MCMerkleBlock
    | MCHeaders
    | MCGetAddr
    | MCFilterLoad
    | MCFilterAdd
    | MCFilterClear
    | MCPing
    | MCPong
    | MCAlert
    | MCMempool
    | MCReject
    | MCSendHeaders
    | MCOther ByteString
    deriving (MessageCommand -> MessageCommand -> Bool
(MessageCommand -> MessageCommand -> Bool)
-> (MessageCommand -> MessageCommand -> Bool) -> Eq MessageCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageCommand -> MessageCommand -> Bool
$c/= :: MessageCommand -> MessageCommand -> Bool
== :: MessageCommand -> MessageCommand -> Bool
$c== :: MessageCommand -> MessageCommand -> Bool
Eq, (forall x. MessageCommand -> Rep MessageCommand x)
-> (forall x. Rep MessageCommand x -> MessageCommand)
-> Generic MessageCommand
forall x. Rep MessageCommand x -> MessageCommand
forall x. MessageCommand -> Rep MessageCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MessageCommand x -> MessageCommand
$cfrom :: forall x. MessageCommand -> Rep MessageCommand x
Generic, MessageCommand -> ()
(MessageCommand -> ()) -> NFData MessageCommand
forall a. (a -> ()) -> NFData a
rnf :: MessageCommand -> ()
$crnf :: MessageCommand -> ()
NFData)

instance Show MessageCommand where
    showsPrec :: Int -> MessageCommand -> ShowS
showsPrec _ = ByteString -> ShowS
forall a. Show a => a -> ShowS
shows (ByteString -> ShowS)
-> (MessageCommand -> ByteString) -> MessageCommand -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MessageCommand -> ByteString
commandToString

instance Read MessageCommand where
    readPrec :: ReadPrec MessageCommand
readPrec = do
        String str :: String
str <- ReadPrec Lexeme
lexP
        MessageCommand -> ReadPrec MessageCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> MessageCommand
stringToCommand (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
str))

instance Serial MessageCommand where
    deserialize :: m MessageCommand
deserialize = ByteString -> MessageCommand
go (ByteString -> MessageCommand) -> m ByteString -> m MessageCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString 12
      where
        go :: ByteString -> MessageCommand
go bs :: ByteString
bs =
            let str :: ByteString
str = ByteString -> ByteString
unpackCommand ByteString
bs
             in ByteString -> MessageCommand
stringToCommand ByteString
str
    serialize :: MessageCommand -> m ()
serialize mc :: MessageCommand
mc = ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
packCommand (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ MessageCommand -> ByteString
commandToString MessageCommand
mc

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

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

instance IsString MessageCommand where
    fromString :: String -> MessageCommand
fromString str :: String
str = ByteString -> MessageCommand
stringToCommand (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
str)

-- | Read a 'MessageCommand' from its string representation.
stringToCommand :: ByteString -> MessageCommand
stringToCommand :: ByteString -> MessageCommand
stringToCommand str :: ByteString
str = case ByteString
str of
    "version"     -> MessageCommand
MCVersion
    "verack"      -> MessageCommand
MCVerAck
    "addr"        -> MessageCommand
MCAddr
    "inv"         -> MessageCommand
MCInv
    "getdata"     -> MessageCommand
MCGetData
    "notfound"    -> MessageCommand
MCNotFound
    "getblocks"   -> MessageCommand
MCGetBlocks
    "getheaders"  -> MessageCommand
MCGetHeaders
    "tx"          -> MessageCommand
MCTx
    "block"       -> MessageCommand
MCBlock
    "merkleblock" -> MessageCommand
MCMerkleBlock
    "headers"     -> MessageCommand
MCHeaders
    "getaddr"     -> MessageCommand
MCGetAddr
    "filterload"  -> MessageCommand
MCFilterLoad
    "filteradd"   -> MessageCommand
MCFilterAdd
    "filterclear" -> MessageCommand
MCFilterClear
    "ping"        -> MessageCommand
MCPing
    "pong"        -> MessageCommand
MCPong
    "alert"       -> MessageCommand
MCAlert
    "mempool"     -> MessageCommand
MCMempool
    "reject"      -> MessageCommand
MCReject
    "sendheaders" -> MessageCommand
MCSendHeaders
    _             -> ByteString -> MessageCommand
MCOther ByteString
str

-- | Convert a 'MessageCommand' to its string representation.
commandToString :: MessageCommand -> ByteString
commandToString :: MessageCommand -> ByteString
commandToString mc :: MessageCommand
mc = case MessageCommand
mc of
    MCVersion     -> "version"
    MCVerAck      -> "verack"
    MCAddr        -> "addr"
    MCInv         -> "inv"
    MCGetData     -> "getdata"
    MCNotFound    -> "notfound"
    MCGetBlocks   -> "getblocks"
    MCGetHeaders  -> "getheaders"
    MCTx          -> "tx"
    MCBlock       -> "block"
    MCMerkleBlock -> "merkleblock"
    MCHeaders     -> "headers"
    MCGetAddr     -> "getaddr"
    MCFilterLoad  -> "filterload"
    MCFilterAdd   -> "filteradd"
    MCFilterClear -> "filterclear"
    MCPing        -> "ping"
    MCPong        -> "pong"
    MCAlert       -> "alert"
    MCMempool     -> "mempool"
    MCReject      -> "reject"
    MCSendHeaders -> "sendheaders"
    MCOther c :: ByteString
c     -> ByteString
c

-- | Pack a string 'MessageCommand' so that it is exactly 12-bytes long.
packCommand :: ByteString -> ByteString
packCommand :: ByteString -> ByteString
packCommand s :: ByteString
s = Int -> ByteString -> ByteString
B.take 12 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
    ByteString
s ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` Int -> Char -> ByteString
C.replicate 12 '\NUL'

-- | Undo packing done by 'packCommand'.
unpackCommand :: ByteString -> ByteString
unpackCommand :: ByteString -> ByteString
unpackCommand = (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0)

-- | Node offers no services.
nodeNone :: Word64
nodeNone :: Word64
nodeNone = 0

-- | Services indicate node is a full node that can serve full blocks.
nodeNetwork :: Word64
nodeNetwork :: Word64
nodeNetwork = 1

-- | Services indicate node allows to request 'UTXO' set.
nodeGetUTXO :: Word64
nodeGetUTXO :: Word64
nodeGetUTXO = 1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 1

-- | Services indicate node accepts bloom filters.
nodeBloom :: Word64
nodeBloom :: Word64
nodeBloom = 1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 2

-- | Services indicate SegWit-capable node.
nodeWitness :: Word64
nodeWitness :: Word64
nodeWitness = 1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 3

-- | Services indicate Xtreme Thinblocks compatibility.
nodeXThin :: Word64
nodeXThin :: Word64
nodeXThin = 1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 4