\subsubsection{Nodes Response (0x04)}

\begin{tabular}{l|l|l}
  Length             & Type        & \href{#rpc-services}{Contents} \\
  \hline
  \texttt{1}         & Int         & Number of nodes in the response (maximum 4) \\
  \texttt{[39, 204]} & Node Infos  & Nodes in Packed Node Format \\
\end{tabular}

An IPv4 node is 39 bytes, an IPv6 node is 51 bytes, so the maximum size of the
packed Node Infos is \texttt{51 * 4 = 204} bytes.

Nodes responses should contain the 4 closest nodes that the sender of the
response has in their lists of known nodes.

\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE Safe               #-}
{-# LANGUAGE StrictData         #-}
module Network.Tox.DHT.NodesResponse where

import           Control.Applicative           ((<$>))
import           Data.Binary                   (Binary, get, put)
import qualified Data.Binary.Get               as Binary (getWord8)
import qualified Data.Binary.Put               as Binary (putWord8)
import           Data.MessagePack              (MessagePack)
import           Data.Typeable                 (Typeable)
import           GHC.Generics                  (Generic)
import           Network.Tox.NodeInfo.NodeInfo (NodeInfo)
import           Test.QuickCheck.Arbitrary     (Arbitrary, arbitrary)


{-------------------------------------------------------------------------------
 -
 - :: Implementation.
 -
 ------------------------------------------------------------------------------}


newtype NodesResponse = NodesResponse
  { NodesResponse -> [NodeInfo]
foundNodes :: [NodeInfo]
  }
  deriving (NodesResponse -> NodesResponse -> Bool
(NodesResponse -> NodesResponse -> Bool)
-> (NodesResponse -> NodesResponse -> Bool) -> Eq NodesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodesResponse -> NodesResponse -> Bool
$c/= :: NodesResponse -> NodesResponse -> Bool
== :: NodesResponse -> NodesResponse -> Bool
$c== :: NodesResponse -> NodesResponse -> Bool
Eq, ReadPrec [NodesResponse]
ReadPrec NodesResponse
Int -> ReadS NodesResponse
ReadS [NodesResponse]
(Int -> ReadS NodesResponse)
-> ReadS [NodesResponse]
-> ReadPrec NodesResponse
-> ReadPrec [NodesResponse]
-> Read NodesResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NodesResponse]
$creadListPrec :: ReadPrec [NodesResponse]
readPrec :: ReadPrec NodesResponse
$creadPrec :: ReadPrec NodesResponse
readList :: ReadS [NodesResponse]
$creadList :: ReadS [NodesResponse]
readsPrec :: Int -> ReadS NodesResponse
$creadsPrec :: Int -> ReadS NodesResponse
Read, Int -> NodesResponse -> ShowS
[NodesResponse] -> ShowS
NodesResponse -> String
(Int -> NodesResponse -> ShowS)
-> (NodesResponse -> String)
-> ([NodesResponse] -> ShowS)
-> Show NodesResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodesResponse] -> ShowS
$cshowList :: [NodesResponse] -> ShowS
show :: NodesResponse -> String
$cshow :: NodesResponse -> String
showsPrec :: Int -> NodesResponse -> ShowS
$cshowsPrec :: Int -> NodesResponse -> ShowS
Show, (forall x. NodesResponse -> Rep NodesResponse x)
-> (forall x. Rep NodesResponse x -> NodesResponse)
-> Generic NodesResponse
forall x. Rep NodesResponse x -> NodesResponse
forall x. NodesResponse -> Rep NodesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodesResponse x -> NodesResponse
$cfrom :: forall x. NodesResponse -> Rep NodesResponse x
Generic, Typeable)

instance MessagePack NodesResponse


instance Binary NodesResponse where
  put :: NodesResponse -> Put
put NodesResponse
res = do
    Word8 -> Put
Binary.putWord8 (Word8 -> Put) -> (NodesResponse -> Word8) -> NodesResponse -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Word8)
-> (NodesResponse -> Integer) -> NodesResponse -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer)
-> (NodesResponse -> Int) -> NodesResponse -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([NodeInfo] -> Int)
-> (NodesResponse -> [NodeInfo]) -> NodesResponse -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodesResponse -> [NodeInfo]
foundNodes (NodesResponse -> Put) -> NodesResponse -> Put
forall a b. (a -> b) -> a -> b
$ NodesResponse
res
    (NodeInfo -> Put) -> [NodeInfo] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ NodeInfo -> Put
forall t. Binary t => t -> Put
put (NodesResponse -> [NodeInfo]
foundNodes NodesResponse
res)

  get :: Get NodesResponse
get = do
    Word8
count <- Get Word8
Binary.getWord8
    [NodeInfo] -> NodesResponse
NodesResponse ([NodeInfo] -> NodesResponse)
-> Get [NodeInfo] -> Get NodesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Get NodeInfo) -> [Word8] -> Get [NodeInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Get NodeInfo -> Word8 -> Get NodeInfo
forall a b. a -> b -> a
const Get NodeInfo
forall t. Binary t => Get t
get) [Word8
1..Word8
count]


{-------------------------------------------------------------------------------
 -
 - :: Tests.
 -
 ------------------------------------------------------------------------------}


instance Arbitrary NodesResponse where
  arbitrary :: Gen NodesResponse
arbitrary = [NodeInfo] -> NodesResponse
NodesResponse ([NodeInfo] -> NodesResponse)
-> Gen [NodeInfo] -> Gen NodesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [NodeInfo]
forall a. Arbitrary a => Gen a
arbitrary
\end{code}