{-# 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.Bits               (shiftL)
import           Data.ByteString         (ByteString)
import qualified Data.ByteString         as B
import           Data.ByteString.Char8   as C (replicate)
import           Data.Serialize          as S
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 Serialize Addr where

    get :: Get Addr
get = [NetworkAddressTime] -> Addr
Addr ([NetworkAddressTime] -> Addr)
-> Get [NetworkAddressTime] -> Get Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> Get [NetworkAddressTime]
repList (VarInt -> Get [NetworkAddressTime])
-> Get VarInt -> Get [NetworkAddressTime]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get VarInt
forall t. Serialize t => Get t
S.get)
      where
        repList :: VarInt -> Get [NetworkAddressTime]
repList (VarInt c :: Word64
c) = Int -> Get NetworkAddressTime -> Get [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) Get NetworkAddressTime
action
        action :: Get NetworkAddressTime
action             = (Word32 -> NetworkAddress -> NetworkAddressTime)
-> Get Word32 -> Get NetworkAddress -> Get NetworkAddressTime
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Get Word32
getWord32le Get NetworkAddress
forall t. Serialize t => Get t
S.get

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

-- | 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 Serialize Alert where
    get :: Get Alert
get = VarString -> VarString -> Alert
Alert (VarString -> VarString -> Alert)
-> Get VarString -> Get (VarString -> Alert)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get VarString
forall t. Serialize t => Get t
S.get Get (VarString -> Alert) -> Get VarString -> Get Alert
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get VarString
forall t. Serialize t => Get t
S.get
    put :: Putter Alert
put (Alert p :: VarString
p s :: VarString
s) = Putter VarString
forall t. Serialize t => Putter t
put VarString
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter VarString
forall t. Serialize t => Putter t
put VarString
s

-- | 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 Serialize GetData where

    get :: Get GetData
get = [InvVector] -> GetData
GetData ([InvVector] -> GetData) -> Get [InvVector] -> Get GetData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> Get [InvVector]
forall a. Serialize a => VarInt -> Get [a]
repList (VarInt -> Get [InvVector]) -> Get VarInt -> Get [InvVector]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get VarInt
forall t. Serialize t => Get t
S.get)
      where
        repList :: VarInt -> Get [a]
repList (VarInt c :: Word64
c) = Int -> Get a -> Get [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) Get a
forall t. Serialize t => Get t
S.get

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

-- | '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 Serialize Inv where

    get :: Get Inv
get = [InvVector] -> Inv
Inv ([InvVector] -> Inv) -> Get [InvVector] -> Get Inv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> Get [InvVector]
forall a. Serialize a => VarInt -> Get [a]
repList (VarInt -> Get [InvVector]) -> Get VarInt -> Get [InvVector]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get VarInt
forall t. Serialize t => Get t
S.get)
      where
        repList :: VarInt -> Get [a]
repList (VarInt c :: Word64
c) = Int -> Get a -> Get [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) Get a
forall t. Serialize t => Get t
S.get

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

-- | 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 filtere block
    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 Serialize InvType where
    get :: Get InvType
get = Word32 -> Get InvType
forall a (m :: * -> *).
(Num a, Bits a, MonadFail m) =>
a -> m InvType
go (Word32 -> Get InvType) -> Get Word32 -> Get InvType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word32
getWord32le
      where
        go :: a -> m InvType
go x :: a
x =
            case a
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
                _
                    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` 30 a -> a -> a
forall a. Num a => a -> a -> a
+ 1 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvWitnessTx
                    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` 30 a -> a -> a
forall a. Num a => a -> a -> a
+ 2 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvWitnessBlock
                    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` 30 a -> a -> a
forall a. Num a => a -> a -> a
+ 3 -> InvType -> m InvType
forall (m :: * -> *) a. Monad m => a -> m a
return InvType
InvWitnessMerkleBlock
                    | Bool
otherwise -> String -> m InvType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "bitcoinGet InvType: Invalid Type"
    put :: Putter InvType
put x :: InvType
x =
        Putter Word32
putWord32le Putter Word32 -> Putter Word32
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

-- | 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 Serialize InvVector where
    get :: Get InvVector
get = InvType -> Hash256 -> InvVector
InvVector (InvType -> Hash256 -> InvVector)
-> Get InvType -> Get (Hash256 -> InvVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get InvType
forall t. Serialize t => Get t
S.get Get (Hash256 -> InvVector) -> Get Hash256 -> Get InvVector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Hash256
forall t. Serialize t => Get t
S.get
    put :: InvVector -> Put
put (InvVector t :: InvType
t h :: Hash256
h) = Putter InvType
forall t. Serialize t => Putter t
put InvType
t Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Hash256
forall t. Serialize t => Putter t
put Hash256
h

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 Serialize HostAddress where
    put :: Putter HostAddress
put (HostAddress bs :: ByteString
bs) = Putter ByteString
putByteString ByteString
bs
    get :: Get HostAddress
get = ByteString -> HostAddress
HostAddress (ByteString -> HostAddress) -> Get ByteString -> Get HostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString 18

-- | 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
runGet Get 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
runPut (Put -> ByteString) -> (SockAddr -> Put) -> SockAddr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SockAddr -> Put
putSockAddr

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

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

putSockAddr _ = String -> Put
forall a. HasCallStack => String -> a
error "Invalid address type"

getSockAddr :: Get SockAddr
getSockAddr :: Get SockAddr
getSockAddr = do
    Word32
a <- Get Word32
getWord32be
    Word32
b <- Get Word32
getWord32be
    Word32
c <- Get 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 <- Get Word32
getWord32host
            Word16
p <- Get Word16
getWord16be
            SockAddr -> Get SockAddr
forall (m :: * -> *) a. Monad m => a -> m a
return (SockAddr -> Get SockAddr) -> SockAddr -> Get 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 <- Get Word32
getWord32be
            Word16
p <- Get Word16
getWord16be
            SockAddr -> Get SockAddr
forall (m :: * -> *) a. Monad m => a -> m a
return (SockAddr -> Get SockAddr) -> SockAddr -> Get 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 Serialize NetworkAddress where
    get :: Get NetworkAddress
get = Word64 -> HostAddress -> NetworkAddress
NetworkAddress (Word64 -> HostAddress -> NetworkAddress)
-> Get Word64 -> Get (HostAddress -> NetworkAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le Get (HostAddress -> NetworkAddress)
-> Get HostAddress -> Get NetworkAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get HostAddress
forall t. Serialize t => Get t
S.get
    put :: Putter NetworkAddress
put (NetworkAddress s :: Word64
s a :: HostAddress
a) = Putter Word64
putWord64le Word64
s Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter HostAddress
forall t. Serialize t => Putter t
put HostAddress
a

-- | 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 Serialize NotFound where

    get :: Get NotFound
get = [InvVector] -> NotFound
NotFound ([InvVector] -> NotFound) -> Get [InvVector] -> Get NotFound
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> Get [InvVector]
forall a. Serialize a => VarInt -> Get [a]
repList (VarInt -> Get [InvVector]) -> Get VarInt -> Get [InvVector]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get VarInt
forall t. Serialize t => Get t
S.get)
      where
        repList :: VarInt -> Get [a]
repList (VarInt c :: Word64
c) = Int -> Get a -> Get [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) Get a
forall t. Serialize t => Get t
S.get

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

-- | 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 Serialize Ping where
    get :: Get Ping
get = Word64 -> Ping
Ping (Word64 -> Ping) -> Get Word64 -> Get Ping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
    put :: Putter Ping
put (Ping n :: Word64
n) = Putter Word64
putWord64le Word64
n

instance Serialize Pong where
    get :: Get Pong
get = Word64 -> Pong
Pong (Word64 -> Pong) -> Get Word64 -> Get Pong
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
    put :: Putter Pong
put (Pong n :: Word64
n) = Putter Word64
putWord64le Word64
n

-- | 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 Serialize RejectCode where

    get :: Get RejectCode
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get RejectCode) -> Get RejectCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \code :: Word8
code -> case Word8
code of
        0x01 -> RejectCode -> Get RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectMalformed
        0x10 -> RejectCode -> Get RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectInvalid
        0x11 -> RejectCode -> Get RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectObsolete
        0x12 -> RejectCode -> Get RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectDuplicate
        0x40 -> RejectCode -> Get RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectNonStandard
        0x41 -> RejectCode -> Get RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectDust
        0x42 -> RejectCode -> Get RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectInsufficientFee
        0x43 -> RejectCode -> Get RejectCode
forall (m :: * -> *) a. Monad m => a -> m a
return RejectCode
RejectCheckpoint
        _    -> String -> Get RejectCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get RejectCode) -> String -> Get 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
            ]

    put :: Putter RejectCode
put code :: RejectCode
code = Putter Word8
putWord8 Putter Word8 -> Putter Word8
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

-- | 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 Serialize Reject where
    get :: Get Reject
get =
        Get VarString
forall t. Serialize t => Get t
S.get Get VarString -> (VarString -> Get Reject) -> Get 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)
-> Get RejectCode -> Get (VarString -> ByteString -> Reject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get RejectCode
forall t. Serialize t => Get t
S.get Get (VarString -> ByteString -> Reject)
-> Get VarString -> Get (ByteString -> Reject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get VarString
forall t. Serialize t => Get t
S.get Get (ByteString -> Reject) -> Get ByteString -> Get Reject
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
maybeData
      where
        maybeData :: Get ByteString
maybeData =
            Get Bool
isEmpty Get Bool -> (Bool -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \done :: Bool
done ->
                if Bool
done
                    then ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
                    else Int -> Get ByteString
getByteString 32
    put :: Putter Reject
put (Reject cmd :: MessageCommand
cmd code :: RejectCode
code reason :: VarString
reason dat :: ByteString
dat) = do
        Putter VarString
forall t. Serialize t => Putter t
put Putter VarString -> Putter VarString
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
        Putter RejectCode
forall t. Serialize t => Putter t
put RejectCode
code
        Putter VarString
forall t. Serialize t => Putter t
put VarString
reason
        Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
dat) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Putter ByteString
putByteString ByteString
dat

-- | 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 Serialize VarInt where

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

    put :: Putter VarInt
put (VarInt x :: Word64
x)
        | Word64
x Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< 0xfd =
            Putter Word8
putWord8 Putter Word8 -> Putter Word8
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
            Putter Word8
putWord8 0xfd
            Putter Word16
putWord16le Putter Word16 -> Putter Word16
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
            Putter Word8
putWord8 0xfe
            Putter Word32
putWord32le Putter Word32 -> Putter Word32
forall a b. (a -> b) -> a -> b
$ Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x
        | Bool
otherwise = do
            Putter Word8
putWord8 0xff
            Putter Word64
putWord64le Word64
x

putVarInt :: Integral a => a -> Put
putVarInt :: a -> Put
putVarInt = Putter VarInt
forall t. Serialize t => Putter t
put Putter VarInt -> (a -> VarInt) -> a -> Put
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 Serialize VarString where

    get :: Get VarString
get = ByteString -> VarString
VarString (ByteString -> VarString) -> Get ByteString -> Get VarString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarInt -> Get ByteString
readBS (VarInt -> Get ByteString) -> Get VarInt -> Get ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get VarInt
forall t. Serialize t => Get t
S.get)
      where
        readBS :: VarInt -> Get ByteString
readBS (VarInt len :: Word64
len) = Int -> Get ByteString
getByteString (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len)

    put :: Putter VarString
put (VarString bs :: ByteString
bs) = do
        Int -> Put
forall a. Integral a => a -> Put
putVarInt (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs
        Putter ByteString
putByteString ByteString
bs

-- | 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 Serialize Version where

    get :: Get Version
get = Word32
-> Word64
-> Word64
-> NetworkAddress
-> NetworkAddress
-> Word64
-> VarString
-> Word32
-> Bool
-> Version
Version (Word32
 -> Word64
 -> Word64
 -> NetworkAddress
 -> NetworkAddress
 -> Word64
 -> VarString
 -> Word32
 -> Bool
 -> Version)
-> Get Word32
-> Get
     (Word64
      -> Word64
      -> NetworkAddress
      -> NetworkAddress
      -> Word64
      -> VarString
      -> Word32
      -> Bool
      -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
                  Get
  (Word64
   -> Word64
   -> NetworkAddress
   -> NetworkAddress
   -> Word64
   -> VarString
   -> Word32
   -> Bool
   -> Version)
-> Get Word64
-> Get
     (Word64
      -> NetworkAddress
      -> NetworkAddress
      -> Word64
      -> VarString
      -> Word32
      -> Bool
      -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
                  Get
  (Word64
   -> NetworkAddress
   -> NetworkAddress
   -> Word64
   -> VarString
   -> Word32
   -> Bool
   -> Version)
-> Get Word64
-> Get
     (NetworkAddress
      -> NetworkAddress
      -> Word64
      -> VarString
      -> Word32
      -> Bool
      -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
                  Get
  (NetworkAddress
   -> NetworkAddress
   -> Word64
   -> VarString
   -> Word32
   -> Bool
   -> Version)
-> Get NetworkAddress
-> Get
     (NetworkAddress
      -> Word64 -> VarString -> Word32 -> Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get NetworkAddress
forall t. Serialize t => Get t
S.get
                  Get
  (NetworkAddress
   -> Word64 -> VarString -> Word32 -> Bool -> Version)
-> Get NetworkAddress
-> Get (Word64 -> VarString -> Word32 -> Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get NetworkAddress
forall t. Serialize t => Get t
S.get
                  Get (Word64 -> VarString -> Word32 -> Bool -> Version)
-> Get Word64 -> Get (VarString -> Word32 -> Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
                  Get (VarString -> Word32 -> Bool -> Version)
-> Get VarString -> Get (Word32 -> Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get VarString
forall t. Serialize t => Get t
S.get
                  Get (Word32 -> Bool -> Version)
-> Get Word32 -> Get (Bool -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32le
                  Get (Bool -> Version) -> Get Bool -> Get Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Get Bool
go (Bool -> Get Bool) -> Get Bool -> Get Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Bool
isEmpty)
      where
        go :: Bool -> Get Bool
go True  = Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        go False = Get Bool
getBool

    put :: Putter Version
put (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
        Putter Word32
putWord32le Word32
v
        Putter Word64
putWord64le Word64
s
        Putter Word64
putWord64le Word64
t
        Putter NetworkAddress
forall t. Serialize t => Putter t
put         NetworkAddress
ar
        Putter NetworkAddress
forall t. Serialize t => Putter t
put         NetworkAddress
as
        Putter Word64
putWord64le Word64
n
        Putter VarString
forall t. Serialize t => Putter t
put         VarString
ua
        Putter Word32
putWord32le Word32
sh
        Bool -> Put
putBool     Bool
r

-- | 0x00 is 'False', anything else is 'True'.
getBool :: Get Bool
getBool :: Get Bool
getBool = Word8 -> Get Bool
forall a (m :: * -> *). (Eq a, Num a, Monad m) => a -> m Bool
go (Word8 -> Get Bool) -> Get Word8 -> Get Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get 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 :: Bool -> Put
putBool :: Bool -> Put
putBool True  = Putter Word8
putWord8 1
putBool False = Putter Word8
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 Serialize MessageCommand where
    get :: Get MessageCommand
get = ByteString -> MessageCommand
go (ByteString -> MessageCommand)
-> Get ByteString -> Get MessageCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get 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
    put :: Putter MessageCommand
put mc :: MessageCommand
mc = Putter ByteString
putByteString Putter ByteString -> Putter ByteString
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 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