\subsection{DHT (0x02)}

\begin{code}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData                 #-}
module Network.Tox.SaveData.DHT (DHT) where

import           Control.Arrow              (second)
import           Control.Monad              (when)
import           Data.Binary                (Binary (..))
import qualified Data.Binary.Get            as Get
import qualified Data.Binary.Put            as Put
import qualified Data.ByteString.Lazy       as LBS
import           Data.MessagePack           (MessagePack)
import           Data.Word                  (Word16, Word32)
import           GHC.Generics               (Generic)
import           Network.Tox.SaveData.Nodes (Nodes)
import qualified Network.Tox.SaveData.Util  as Util
import           Test.QuickCheck.Arbitrary  (Arbitrary, arbitrary)
import qualified Test.QuickCheck.Gen        as Gen

\end{code}

This section contains a list of DHT-related sections.

\begin{tabular}{l|l}
  Length        & Contents \\
  \hline
  \texttt{4}    & \texttt{uint32\_t} (0x159000D) \\
  \texttt{?}    & List of DHT sections \\
\end{tabular}

\subsubsection{DHT Sections}

Every DHT section has the following structure:

\begin{tabular}{l|l}
  Length        & Contents \\
  \hline
  \texttt{4}    & \texttt{uint32\_t} Length of this section \\
  \texttt{2}    & \texttt{uint16\_t} DHT section type \\
  \texttt{2}    & \texttt{uint16\_t} (0x11CE) \\
  \texttt{?}    & DHT section \\
\end{tabular}

DHT section types:

\begin{tabular}{l|l}
  Name  & Value \\
  \hline
  Nodes & 0x04 \\
\end{tabular}

\paragraph{Nodes (0x04)}

This section contains a list of nodes. These nodes are used to quickly reconnect
to the DHT after a Tox client is restarted.

\begin{tabular}{l|l}
  Length        & Contents \\
  \hline
  \texttt{?}    & List of nodes \\
\end{tabular}

The structure of a node is the same as \texttt{Node Info}. Note: this means
that the integers stored in these nodes are stored in Big Endian as well.

\begin{code}

dhtMagic :: Word32
dhtMagic :: Word32
dhtMagic = Word32
0x0159000D

sectionMagic :: Word16
sectionMagic :: Word16
sectionMagic =  Word16
0x11CE

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

instance MessagePack DHT

instance Arbitrary DHT where
    arbitrary :: Gen DHT
arbitrary = [DhtSection] -> DHT
DHT ([DhtSection] -> DHT) -> Gen [DhtSection] -> Gen DHT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [DhtSection]
forall a. Arbitrary a => Gen a
arbitrary

instance Binary DHT where
    get :: Get DHT
get = do
        Word32
magic <- Get Word32
Get.getWord32le
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
magic Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
dhtMagic) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
            String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"wrong magic number for DHT savedata: "
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
magic String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" != " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
dhtMagic

        [DhtSection] -> DHT
DHT ([DhtSection] -> DHT) -> Get [DhtSection] -> Get DHT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [DhtSection]
forall a. (Binary a, Show a) => Get [a]
Util.getList

    put :: DHT -> Put
put (DHT [DhtSection]
sections) = do
        Word32 -> Put
Put.putWord32le Word32
dhtMagic
        (DhtSection -> Put) -> [DhtSection] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DhtSection -> Put
forall t. Binary t => t -> Put
put [DhtSection]
sections


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

instance MessagePack DhtSection

instance Binary DhtSection where
    get :: Get DhtSection
get = do
        (Int
len, Word16
ty) <- Word16 -> Get (Int, Word16)
Util.getSectionHeader Word16
sectionMagic
        Int -> Get DhtSection -> Get DhtSection
forall a. Int -> Get a -> Get a
Get.isolate Int
len (Get DhtSection -> Get DhtSection)
-> Get DhtSection -> Get DhtSection
forall a b. (a -> b) -> a -> b
$ case Word16
ty of
            Word16
0x04 -> Nodes -> DhtSection
DhtSectionNodes (Nodes -> DhtSection) -> Get Nodes -> Get DhtSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Nodes
forall t. Binary t => Get t
get
            Word16
_    -> String -> Get DhtSection
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get DhtSection) -> String -> Get DhtSection
forall a b. (a -> b) -> a -> b
$ Word16 -> String
forall a. Show a => a -> String
show Word16
ty

    put :: DhtSection -> Put
put DhtSection
section = do
        let (Word16
ty, ByteString
bytes) = (Put -> ByteString) -> (Word16, Put) -> (Word16, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Put -> ByteString
Put.runPut (Word16, Put)
output

        Word16 -> Word32 -> Word16 -> Put
Util.putSectionHeader Word16
sectionMagic (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> Int64 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LBS.length ByteString
bytes) Word16
ty
        ByteString -> Put
Put.putLazyByteString ByteString
bytes

      where
        output :: (Word16, Put)
output = case DhtSection
section of
            DhtSectionNodes Nodes
x -> (Word16
0x04, Nodes -> Put
forall t. Binary t => t -> Put
put Nodes
x)

instance Arbitrary DhtSection where
    arbitrary :: Gen DhtSection
arbitrary = [Gen DhtSection] -> Gen DhtSection
forall a. HasCallStack => [Gen a] -> Gen a
Gen.oneof
        [ Nodes -> DhtSection
DhtSectionNodes (Nodes -> DhtSection) -> Gen Nodes -> Gen DhtSection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Nodes
forall a. Arbitrary a => Gen a
arbitrary
        ]

\end{code}