\section{DHT node state}

\begin{code}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE StrictData            #-}
module Network.Tox.DHT.DhtState where

import           Control.Applicative            (Const (..), getConst, (<|>))
import           Data.Functor.Identity          (Identity (..))
import           Data.List                      (nub, sortBy)
import           Data.Map                       (Map)
import qualified Data.Map                       as Map
import qualified Data.Maybe                     as Maybe
import           Data.Monoid                    (All (..), getAll)
import           Data.Ord                       (comparing)
import           Lens.Family2                   (Lens')
import           Test.QuickCheck.Arbitrary      (Arbitrary, arbitrary, shrink)

import           Network.Tox.Crypto.Key         (PublicKey)
import           Network.Tox.Crypto.KeyPair     (KeyPair)
import qualified Network.Tox.Crypto.KeyPair     as KeyPair
import           Network.Tox.DHT.ClientList     (ClientList)
import qualified Network.Tox.DHT.ClientList     as ClientList
import           Network.Tox.DHT.Distance       (Distance)
import           Network.Tox.DHT.KBuckets       (KBuckets)
import qualified Network.Tox.DHT.KBuckets       as KBuckets
import           Network.Tox.DHT.NodeList       (NodeList)
import qualified Network.Tox.DHT.NodeList       as NodeList
import           Network.Tox.DHT.PendingReplies (PendingReplies)
import qualified Network.Tox.DHT.Stamped        as Stamped
import           Network.Tox.NodeInfo.NodeInfo  (NodeInfo)
import qualified Network.Tox.NodeInfo.NodeInfo  as NodeInfo
import           Network.Tox.Time               (Timestamp)


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


\end{code}

Every DHT node contains the following state:

\begin{itemize}
  \item DHT Key Pair: The Key Pair used to communicate with other DHT nodes. It
    is immutable throughout the lifetime of the DHT node.
  \item DHT Close List: A set of Node Infos of nodes that are close to the
    DHT Public Key (public part of the DHT Key Pair).  The Close List is
    represented as a \href{#k-buckets}{k-buckets} data structure, with the DHT
    Public Key as the Base Key.
  \item DHT Search List: A list of Public Keys of nodes that the DHT node is
    searching for, associated with a DHT Search Entry.
\end{itemize}

\begin{code}

data ListStamp = ListStamp { ListStamp -> Timestamp
listTime :: Timestamp, ListStamp -> Int
listBootstrappedTimes :: Int }
  deriving (ListStamp -> ListStamp -> Bool
(ListStamp -> ListStamp -> Bool)
-> (ListStamp -> ListStamp -> Bool) -> Eq ListStamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStamp -> ListStamp -> Bool
$c/= :: ListStamp -> ListStamp -> Bool
== :: ListStamp -> ListStamp -> Bool
$c== :: ListStamp -> ListStamp -> Bool
Eq, ReadPrec [ListStamp]
ReadPrec ListStamp
Int -> ReadS ListStamp
ReadS [ListStamp]
(Int -> ReadS ListStamp)
-> ReadS [ListStamp]
-> ReadPrec ListStamp
-> ReadPrec [ListStamp]
-> Read ListStamp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStamp]
$creadListPrec :: ReadPrec [ListStamp]
readPrec :: ReadPrec ListStamp
$creadPrec :: ReadPrec ListStamp
readList :: ReadS [ListStamp]
$creadList :: ReadS [ListStamp]
readsPrec :: Int -> ReadS ListStamp
$creadsPrec :: Int -> ReadS ListStamp
Read, Int -> ListStamp -> ShowS
[ListStamp] -> ShowS
ListStamp -> String
(Int -> ListStamp -> ShowS)
-> (ListStamp -> String)
-> ([ListStamp] -> ShowS)
-> Show ListStamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStamp] -> ShowS
$cshowList :: [ListStamp] -> ShowS
show :: ListStamp -> String
$cshow :: ListStamp -> String
showsPrec :: Int -> ListStamp -> ShowS
$cshowsPrec :: Int -> ListStamp -> ShowS
Show)
newListStamp :: Timestamp -> ListStamp
newListStamp :: Timestamp -> ListStamp
newListStamp Timestamp
t = Timestamp -> Int -> ListStamp
ListStamp Timestamp
t Int
0

data DhtState = DhtState
  { DhtState -> KeyPair
dhtKeyPair        :: KeyPair
  , DhtState -> KBuckets
dhtCloseList      :: KBuckets
  , DhtState -> Map PublicKey DhtSearchEntry
dhtSearchList     :: Map PublicKey DhtSearchEntry

  , DhtState -> ListStamp
dhtCloseListStamp :: ListStamp
  , DhtState -> PendingReplies
dhtPendingReplies :: PendingReplies
  }
  deriving (DhtState -> DhtState -> Bool
(DhtState -> DhtState -> Bool)
-> (DhtState -> DhtState -> Bool) -> Eq DhtState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DhtState -> DhtState -> Bool
$c/= :: DhtState -> DhtState -> Bool
== :: DhtState -> DhtState -> Bool
$c== :: DhtState -> DhtState -> Bool
Eq, ReadPrec [DhtState]
ReadPrec DhtState
Int -> ReadS DhtState
ReadS [DhtState]
(Int -> ReadS DhtState)
-> ReadS [DhtState]
-> ReadPrec DhtState
-> ReadPrec [DhtState]
-> Read DhtState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DhtState]
$creadListPrec :: ReadPrec [DhtState]
readPrec :: ReadPrec DhtState
$creadPrec :: ReadPrec DhtState
readList :: ReadS [DhtState]
$creadList :: ReadS [DhtState]
readsPrec :: Int -> ReadS DhtState
$creadsPrec :: Int -> ReadS DhtState
Read, Int -> DhtState -> ShowS
[DhtState] -> ShowS
DhtState -> String
(Int -> DhtState -> ShowS)
-> (DhtState -> String) -> ([DhtState] -> ShowS) -> Show DhtState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DhtState] -> ShowS
$cshowList :: [DhtState] -> ShowS
show :: DhtState -> String
$cshow :: DhtState -> String
showsPrec :: Int -> DhtState -> ShowS
$cshowsPrec :: Int -> DhtState -> ShowS
Show)

_dhtKeyPair :: Lens' DhtState KeyPair
_dhtKeyPair :: LensLike' f DhtState KeyPair
_dhtKeyPair KeyPair -> f KeyPair
f d :: DhtState
d@DhtState{ dhtKeyPair :: DhtState -> KeyPair
dhtKeyPair = KeyPair
a } =
  (\KeyPair
a' -> DhtState
d{ dhtKeyPair :: KeyPair
dhtKeyPair = KeyPair
a' }) (KeyPair -> DhtState) -> f KeyPair -> f DhtState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyPair -> f KeyPair
f KeyPair
a

_dhtCloseListStamp :: Lens' DhtState ListStamp
_dhtCloseListStamp :: LensLike' f DhtState ListStamp
_dhtCloseListStamp ListStamp -> f ListStamp
f d :: DhtState
d@DhtState{ dhtCloseListStamp :: DhtState -> ListStamp
dhtCloseListStamp = ListStamp
a } =
  (\ListStamp
a' -> DhtState
d{ dhtCloseListStamp :: ListStamp
dhtCloseListStamp = ListStamp
a' }) (ListStamp -> DhtState) -> f ListStamp -> f DhtState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListStamp -> f ListStamp
f ListStamp
a

_dhtCloseList :: Lens' DhtState KBuckets
_dhtCloseList :: LensLike' f DhtState KBuckets
_dhtCloseList KBuckets -> f KBuckets
f d :: DhtState
d@DhtState{ dhtCloseList :: DhtState -> KBuckets
dhtCloseList = KBuckets
a } =
  (\KBuckets
a' -> DhtState
d{ dhtCloseList :: KBuckets
dhtCloseList = KBuckets
a' }) (KBuckets -> DhtState) -> f KBuckets -> f DhtState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KBuckets -> f KBuckets
f KBuckets
a

_dhtSearchList :: Lens' DhtState (Map PublicKey DhtSearchEntry)
_dhtSearchList :: LensLike' f DhtState (Map PublicKey DhtSearchEntry)
_dhtSearchList Map PublicKey DhtSearchEntry -> f (Map PublicKey DhtSearchEntry)
f d :: DhtState
d@DhtState{ dhtSearchList :: DhtState -> Map PublicKey DhtSearchEntry
dhtSearchList = Map PublicKey DhtSearchEntry
a } =
  (\Map PublicKey DhtSearchEntry
a' -> DhtState
d{ dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList = Map PublicKey DhtSearchEntry
a' }) (Map PublicKey DhtSearchEntry -> DhtState)
-> f (Map PublicKey DhtSearchEntry) -> f DhtState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PublicKey DhtSearchEntry -> f (Map PublicKey DhtSearchEntry)
f Map PublicKey DhtSearchEntry
a

_dhtPendingReplies :: Lens' DhtState PendingReplies
_dhtPendingReplies :: LensLike' f DhtState PendingReplies
_dhtPendingReplies PendingReplies -> f PendingReplies
f d :: DhtState
d@DhtState{ dhtPendingReplies :: DhtState -> PendingReplies
dhtPendingReplies = PendingReplies
a } =
  (\PendingReplies
a' -> DhtState
d{ dhtPendingReplies :: PendingReplies
dhtPendingReplies = PendingReplies
a' }) (PendingReplies -> DhtState) -> f PendingReplies -> f DhtState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PendingReplies -> f PendingReplies
f PendingReplies
a

\end{code}

A DHT node state is initialised using a Key Pair, which is stored in the state
as DHT Key Pair and as base key for the Close List. Both the Close and Search
Lists are initialised to be empty.

\begin{code}

empty :: Timestamp -> KeyPair -> DhtState
empty :: Timestamp -> KeyPair -> DhtState
empty Timestamp
time KeyPair
keyPair =
  KeyPair
-> KBuckets
-> Map PublicKey DhtSearchEntry
-> ListStamp
-> PendingReplies
-> DhtState
DhtState KeyPair
keyPair (PublicKey -> KBuckets
KBuckets.empty (PublicKey -> KBuckets) -> PublicKey -> KBuckets
forall a b. (a -> b) -> a -> b
$ KeyPair -> PublicKey
KeyPair.publicKey KeyPair
keyPair)
    Map PublicKey DhtSearchEntry
forall k a. Map k a
Map.empty (Timestamp -> ListStamp
newListStamp Timestamp
time) PendingReplies
forall a. Stamped a
Stamped.empty

\end{code}

\subsection{DHT Search Entry}

A DHT Search Entry contains a Client List with base key the searched node's
Public Key.  Once the searched node is found, it is also stored in the Search
Entry.

The maximum size of the Client List is set to 8.
(Must be the same or smaller than the bucket size of the close list to make
sure all the closest peers found will know the node being searched
(TODO(zugz): this argument is unclear.)).

A DHT node state therefore contains one Client List for each bucket index in
the Close List, and one Client List for each DHT Search Entry.
These lists are not required to be disjoint - a node may be in multiple Client
Lists simultaneously.

\begin{code}

data DhtSearchEntry = DhtSearchEntry
  { DhtSearchEntry -> Maybe NodeInfo
searchNode       :: Maybe NodeInfo
  , DhtSearchEntry -> ListStamp
searchStamp      :: ListStamp
  , DhtSearchEntry -> ClientList
searchClientList :: ClientList
  }
  deriving (DhtSearchEntry -> DhtSearchEntry -> Bool
(DhtSearchEntry -> DhtSearchEntry -> Bool)
-> (DhtSearchEntry -> DhtSearchEntry -> Bool) -> Eq DhtSearchEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DhtSearchEntry -> DhtSearchEntry -> Bool
$c/= :: DhtSearchEntry -> DhtSearchEntry -> Bool
== :: DhtSearchEntry -> DhtSearchEntry -> Bool
$c== :: DhtSearchEntry -> DhtSearchEntry -> Bool
Eq, ReadPrec [DhtSearchEntry]
ReadPrec DhtSearchEntry
Int -> ReadS DhtSearchEntry
ReadS [DhtSearchEntry]
(Int -> ReadS DhtSearchEntry)
-> ReadS [DhtSearchEntry]
-> ReadPrec DhtSearchEntry
-> ReadPrec [DhtSearchEntry]
-> Read DhtSearchEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DhtSearchEntry]
$creadListPrec :: ReadPrec [DhtSearchEntry]
readPrec :: ReadPrec DhtSearchEntry
$creadPrec :: ReadPrec DhtSearchEntry
readList :: ReadS [DhtSearchEntry]
$creadList :: ReadS [DhtSearchEntry]
readsPrec :: Int -> ReadS DhtSearchEntry
$creadsPrec :: Int -> ReadS DhtSearchEntry
Read, Int -> DhtSearchEntry -> ShowS
[DhtSearchEntry] -> ShowS
DhtSearchEntry -> String
(Int -> DhtSearchEntry -> ShowS)
-> (DhtSearchEntry -> String)
-> ([DhtSearchEntry] -> ShowS)
-> Show DhtSearchEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DhtSearchEntry] -> ShowS
$cshowList :: [DhtSearchEntry] -> ShowS
show :: DhtSearchEntry -> String
$cshow :: DhtSearchEntry -> String
showsPrec :: Int -> DhtSearchEntry -> ShowS
$cshowsPrec :: Int -> DhtSearchEntry -> ShowS
Show)

_searchNode :: Lens' DhtSearchEntry (Maybe NodeInfo)
_searchNode :: LensLike' f DhtSearchEntry (Maybe NodeInfo)
_searchNode Maybe NodeInfo -> f (Maybe NodeInfo)
f d :: DhtSearchEntry
d@DhtSearchEntry{ searchNode :: DhtSearchEntry -> Maybe NodeInfo
searchNode = Maybe NodeInfo
a } =
  (\Maybe NodeInfo
a' -> DhtSearchEntry
d{ searchNode :: Maybe NodeInfo
searchNode = Maybe NodeInfo
a' }) (Maybe NodeInfo -> DhtSearchEntry)
-> f (Maybe NodeInfo) -> f DhtSearchEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NodeInfo -> f (Maybe NodeInfo)
f Maybe NodeInfo
a

_searchStamp :: Lens' DhtSearchEntry ListStamp
_searchStamp :: LensLike' f DhtSearchEntry ListStamp
_searchStamp ListStamp -> f ListStamp
f d :: DhtSearchEntry
d@DhtSearchEntry{ searchStamp :: DhtSearchEntry -> ListStamp
searchStamp = ListStamp
a } =
  (\ListStamp
a' -> DhtSearchEntry
d{ searchStamp :: ListStamp
searchStamp = ListStamp
a' }) (ListStamp -> DhtSearchEntry) -> f ListStamp -> f DhtSearchEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListStamp -> f ListStamp
f ListStamp
a

_searchClientList :: Lens' DhtSearchEntry ClientList
_searchClientList :: LensLike' f DhtSearchEntry ClientList
_searchClientList ClientList -> f ClientList
f d :: DhtSearchEntry
d@DhtSearchEntry{ searchClientList :: DhtSearchEntry -> ClientList
searchClientList = ClientList
a } =
  (\ClientList
a' -> DhtSearchEntry
d{ searchClientList :: ClientList
searchClientList = ClientList
a' }) (ClientList -> DhtSearchEntry) -> f ClientList -> f DhtSearchEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientList -> f ClientList
f ClientList
a

searchEntryClientListSize :: Int
searchEntryClientListSize :: Int
searchEntryClientListSize = Int
8

\end{code}

A Search Entry is initialised with the searched-for Public Key. The contained
Client List is initialised to be empty.

\begin{code}

emptySearchEntry :: Timestamp -> PublicKey -> DhtSearchEntry
emptySearchEntry :: Timestamp -> PublicKey -> DhtSearchEntry
emptySearchEntry Timestamp
time PublicKey
publicKey =
  Maybe NodeInfo -> ListStamp -> ClientList -> DhtSearchEntry
DhtSearchEntry Maybe NodeInfo
forall a. Maybe a
Nothing (Timestamp -> ListStamp
newListStamp Timestamp
time) (ClientList -> DhtSearchEntry) -> ClientList -> DhtSearchEntry
forall a b. (a -> b) -> a -> b
$
    PublicKey -> Int -> ClientList
ClientList.empty PublicKey
publicKey Int
searchEntryClientListSize

\end{code}

\subsection{Manipulating the DHT node state}

Adding a search key to the DHT node state creates an empty entry in the Search
Nodes list. If a search entry for the public key already existed, the "add"
operation has no effect.

\begin{code}

addSearchKey :: Timestamp -> PublicKey -> DhtState -> DhtState
addSearchKey :: Timestamp -> PublicKey -> DhtState -> DhtState
addSearchKey Timestamp
time PublicKey
searchKey dhtState :: DhtState
dhtState@DhtState { Map PublicKey DhtSearchEntry
dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList :: DhtState -> Map PublicKey DhtSearchEntry
dhtSearchList } =
  DhtState
dhtState { dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList = Map PublicKey DhtSearchEntry
updatedSearchList }
  where
    searchEntry :: DhtSearchEntry
searchEntry =
      DhtSearchEntry
-> PublicKey -> Map PublicKey DhtSearchEntry -> DhtSearchEntry
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Timestamp -> PublicKey -> DhtSearchEntry
emptySearchEntry Timestamp
time PublicKey
searchKey) PublicKey
searchKey Map PublicKey DhtSearchEntry
dhtSearchList
    updatedSearchList :: Map PublicKey DhtSearchEntry
updatedSearchList =
      PublicKey
-> DhtSearchEntry
-> Map PublicKey DhtSearchEntry
-> Map PublicKey DhtSearchEntry
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PublicKey
searchKey DhtSearchEntry
searchEntry Map PublicKey DhtSearchEntry
dhtSearchList

\end{code}

Removing a search key removes its search entry and all associated data
structures from memory.

\begin{code}

removeSearchKey :: PublicKey -> DhtState -> DhtState
removeSearchKey :: PublicKey -> DhtState -> DhtState
removeSearchKey PublicKey
searchKey dhtState :: DhtState
dhtState@DhtState { Map PublicKey DhtSearchEntry
dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList :: DhtState -> Map PublicKey DhtSearchEntry
dhtSearchList } =
  DhtState
dhtState { dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList = PublicKey
-> Map PublicKey DhtSearchEntry -> Map PublicKey DhtSearchEntry
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete PublicKey
searchKey Map PublicKey DhtSearchEntry
dhtSearchList }


containsSearchKey :: PublicKey -> DhtState -> Bool
containsSearchKey :: PublicKey -> DhtState -> Bool
containsSearchKey PublicKey
searchKey =
  PublicKey -> Map PublicKey DhtSearchEntry -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member PublicKey
searchKey (Map PublicKey DhtSearchEntry -> Bool)
-> (DhtState -> Map PublicKey DhtSearchEntry) -> DhtState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhtState -> Map PublicKey DhtSearchEntry
dhtSearchList

\end{code}

\input{src/Network/Tox/DHT/NodeList.lhs}

The iteration order over the DHT state is to first process the Close List
k-buckets, then the Search List entry Client Lists. Each of these follows the
iteration order in the corresponding specification.

\begin{code}

traverseNodeLists :: Applicative f =>
  (forall l. NodeList l => l -> f l) -> DhtState -> f DhtState
traverseNodeLists :: (forall l. NodeList l => l -> f l) -> DhtState -> f DhtState
traverseNodeLists forall l. NodeList l => l -> f l
f dhtState :: DhtState
dhtState@DhtState{ KBuckets
dhtCloseList :: KBuckets
dhtCloseList :: DhtState -> KBuckets
dhtCloseList, Map PublicKey DhtSearchEntry
dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList :: DhtState -> Map PublicKey DhtSearchEntry
dhtSearchList } =
  (\KBuckets
close' Map PublicKey DhtSearchEntry
search' ->
      DhtState
dhtState{ dhtCloseList :: KBuckets
dhtCloseList = KBuckets
close', dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList = Map PublicKey DhtSearchEntry
search' }) (KBuckets -> Map PublicKey DhtSearchEntry -> DhtState)
-> f KBuckets -> f (Map PublicKey DhtSearchEntry -> DhtState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    KBuckets -> f KBuckets
forall l. NodeList l => l -> f l
f KBuckets
dhtCloseList f (Map PublicKey DhtSearchEntry -> DhtState)
-> f (Map PublicKey DhtSearchEntry) -> f DhtState
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (DhtSearchEntry -> f DhtSearchEntry)
-> Map PublicKey DhtSearchEntry -> f (Map PublicKey DhtSearchEntry)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse DhtSearchEntry -> f DhtSearchEntry
traverseEntry Map PublicKey DhtSearchEntry
dhtSearchList
  where
    traverseEntry :: DhtSearchEntry -> f DhtSearchEntry
traverseEntry DhtSearchEntry
entry =
      (\ClientList
x -> DhtSearchEntry
entry{ searchClientList :: ClientList
searchClientList = ClientList
x }) (ClientList -> DhtSearchEntry) -> f ClientList -> f DhtSearchEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientList -> f ClientList
forall l. NodeList l => l -> f l
f (DhtSearchEntry -> ClientList
searchClientList DhtSearchEntry
entry)

foldMapNodeLists :: Monoid m =>
  (forall l. NodeList l => l -> m) -> DhtState -> m
foldMapNodeLists :: (forall l. NodeList l => l -> m) -> DhtState -> m
foldMapNodeLists forall l. NodeList l => l -> m
f = Const m DhtState -> m
forall a k (b :: k). Const a b -> a
getConst (Const m DhtState -> m)
-> (DhtState -> Const m DhtState) -> DhtState -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall l. NodeList l => l -> Const m l)
-> DhtState -> Const m DhtState
forall (f :: * -> *).
Applicative f =>
(forall l. NodeList l => l -> f l) -> DhtState -> f DhtState
traverseNodeLists (m -> Const m l
forall k a (b :: k). a -> Const a b
Const (m -> Const m l) -> (l -> m) -> l -> Const m l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> m
forall l. NodeList l => l -> m
f)

mapNodeLists :: (forall l. NodeList l => l -> l) -> DhtState -> DhtState
mapNodeLists :: (forall l. NodeList l => l -> l) -> DhtState -> DhtState
mapNodeLists forall l. NodeList l => l -> l
f = Identity DhtState -> DhtState
forall a. Identity a -> a
runIdentity (Identity DhtState -> DhtState)
-> (DhtState -> Identity DhtState) -> DhtState -> DhtState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall l. NodeList l => l -> Identity l)
-> DhtState -> Identity DhtState
forall (f :: * -> *).
Applicative f =>
(forall l. NodeList l => l -> f l) -> DhtState -> f DhtState
traverseNodeLists (l -> Identity l
forall a. a -> Identity a
Identity (l -> Identity l) -> (l -> l) -> l -> Identity l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> l
forall l. NodeList l => l -> l
f)

\end{code}

A node info is considered to be contained in the DHT State if it is contained
in the Close List or in at least one of the Search Entries.

The size of the DHT state is defined to be the number of node infos it
contains, counted with multiplicity: node infos contained multiple times, e.g.
in the close list and in various search entries, are counted as many times as
they appear.  Search keys do not directly count towards the state size.  So
the size of the state is the sum of the sizes of the Close List and the Search
Entries.

The state size is relevant to later pruning algorithms that decide when to
remove a node info and when to request a ping from stale nodes. Search keys,
once added, are never automatically pruned.

\begin{code}

size :: DhtState -> Int
size :: DhtState -> Int
size = (Int -> NodeInfo -> Int) -> Int -> DhtState -> Int
forall l a. NodeList l => (a -> NodeInfo -> a) -> a -> l -> a
NodeList.foldNodes ((NodeInfo -> Int -> Int) -> Int -> NodeInfo -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((NodeInfo -> Int -> Int) -> Int -> NodeInfo -> Int)
-> (NodeInfo -> Int -> Int) -> Int -> NodeInfo -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> NodeInfo -> Int -> Int
forall a b. a -> b -> a
const (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)) Int
0

\end{code}

Adding a Node Info to the state is done by adding the node to each Node List
in the state.

When adding a node info to the state, the search entry for the node's public
key, if it exists, is updated to contain the new node info. All k-buckets and
Client Lists that already contain the node info will also be updated. See the
corresponding specifications for the update algorithms. However, a node info
will not be added to a search entry when it is the node to which the search
entry is associated (i.e. the node being search for).

\begin{code}

addNode :: Timestamp -> NodeInfo -> DhtState -> DhtState
addNode :: Timestamp -> NodeInfo -> DhtState -> DhtState
addNode Timestamp
time NodeInfo
nodeInfo =
  PublicKey -> Maybe NodeInfo -> DhtState -> DhtState
updateSearchNode (NodeInfo -> PublicKey
NodeInfo.publicKey NodeInfo
nodeInfo) (NodeInfo -> Maybe NodeInfo
forall a. a -> Maybe a
Just NodeInfo
nodeInfo)
  (DhtState -> DhtState)
-> (DhtState -> DhtState) -> DhtState -> DhtState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall l. NodeList l => l -> l) -> DhtState -> DhtState
mapNodeLists forall l. NodeList l => l -> l
addUnlessBase
  where
    addUnlessBase :: l -> l
addUnlessBase l
nodeList
      | NodeInfo -> PublicKey
NodeInfo.publicKey NodeInfo
nodeInfo PublicKey -> PublicKey -> Bool
forall a. Eq a => a -> a -> Bool
== l -> PublicKey
forall l. NodeList l => l -> PublicKey
NodeList.baseKey l
nodeList = l
nodeList
    addUnlessBase l
nodeList = Timestamp -> NodeInfo -> l -> l
forall l. NodeList l => Timestamp -> NodeInfo -> l -> l
NodeList.addNode Timestamp
time NodeInfo
nodeInfo l
nodeList

removeNode :: PublicKey -> DhtState -> DhtState
removeNode :: PublicKey -> DhtState -> DhtState
removeNode PublicKey
publicKey =
  PublicKey -> Maybe NodeInfo -> DhtState -> DhtState
updateSearchNode PublicKey
publicKey Maybe NodeInfo
forall a. Maybe a
Nothing
  (DhtState -> DhtState)
-> (DhtState -> DhtState) -> DhtState -> DhtState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall l. NodeList l => l -> l) -> DhtState -> DhtState
mapNodeLists (PublicKey -> l -> l
forall l. NodeList l => PublicKey -> l -> l
NodeList.removeNode PublicKey
publicKey)

viable :: NodeInfo -> DhtState -> Bool
viable :: NodeInfo -> DhtState -> Bool
viable NodeInfo
nodeInfo = All -> Bool
getAll (All -> Bool) -> (DhtState -> All) -> DhtState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall l. NodeList l => l -> All) -> DhtState -> All
forall m.
Monoid m =>
(forall l. NodeList l => l -> m) -> DhtState -> m
foldMapNodeLists (Bool -> All
All (Bool -> All) -> (l -> Bool) -> l -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo -> l -> Bool
forall l. NodeList l => NodeInfo -> l -> Bool
NodeList.viable NodeInfo
nodeInfo)

traverseClientLists ::
  Applicative f => (ClientList -> f ClientList) -> DhtState -> f DhtState
traverseClientLists :: (ClientList -> f ClientList) -> DhtState -> f DhtState
traverseClientLists ClientList -> f ClientList
f = (forall l. NodeList l => l -> f l) -> DhtState -> f DhtState
forall (f :: * -> *).
Applicative f =>
(forall l. NodeList l => l -> f l) -> DhtState -> f DhtState
traverseNodeLists ((forall l. NodeList l => l -> f l) -> DhtState -> f DhtState)
-> (forall l. NodeList l => l -> f l) -> DhtState -> f DhtState
forall a b. (a -> b) -> a -> b
$ (ClientList -> f ClientList) -> l -> f l
forall l (f :: * -> *).
(NodeList l, Applicative f) =>
(ClientList -> f ClientList) -> l -> f l
NodeList.traverseClientLists ClientList -> f ClientList
f

closeNodes :: PublicKey -> DhtState -> [ (Distance, NodeInfo) ]
closeNodes :: PublicKey -> DhtState -> [(Distance, NodeInfo)]
closeNodes PublicKey
publicKey =
  [(Distance, NodeInfo)] -> [(Distance, NodeInfo)]
forall a. Eq a => [a] -> [a]
nub ([(Distance, NodeInfo)] -> [(Distance, NodeInfo)])
-> (DhtState -> [(Distance, NodeInfo)])
-> DhtState
-> [(Distance, NodeInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Distance, NodeInfo) -> (Distance, NodeInfo) -> Ordering)
-> [(Distance, NodeInfo)] -> [(Distance, NodeInfo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Distance, NodeInfo) -> Distance)
-> (Distance, NodeInfo) -> (Distance, NodeInfo) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Distance, NodeInfo) -> Distance
forall a b. (a, b) -> a
fst) ([(Distance, NodeInfo)] -> [(Distance, NodeInfo)])
-> (DhtState -> [(Distance, NodeInfo)])
-> DhtState
-> [(Distance, NodeInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall l. NodeList l => l -> [(Distance, NodeInfo)])
-> DhtState -> [(Distance, NodeInfo)]
forall m.
Monoid m =>
(forall l. NodeList l => l -> m) -> DhtState -> m
foldMapNodeLists (PublicKey -> l -> [(Distance, NodeInfo)]
forall l. NodeList l => PublicKey -> l -> [(Distance, NodeInfo)]
NodeList.closeNodes PublicKey
publicKey)

-- | although it is not referred to as a Node List in the spec, we make DhtState
-- an instance of NodeList so we can use the traversal and folding functions.
instance NodeList DhtState where
  addNode :: Timestamp -> NodeInfo -> DhtState -> DhtState
addNode = Timestamp -> NodeInfo -> DhtState -> DhtState
addNode
  removeNode :: PublicKey -> DhtState -> DhtState
removeNode = PublicKey -> DhtState -> DhtState
removeNode
  viable :: NodeInfo -> DhtState -> Bool
viable = NodeInfo -> DhtState -> Bool
viable
  baseKey :: DhtState -> PublicKey
baseKey = KeyPair -> PublicKey
KeyPair.publicKey (KeyPair -> PublicKey)
-> (DhtState -> KeyPair) -> DhtState -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhtState -> KeyPair
dhtKeyPair
  traverseClientLists :: (ClientList -> f ClientList) -> DhtState -> f DhtState
traverseClientLists = (ClientList -> f ClientList) -> DhtState -> f DhtState
forall (f :: * -> *).
Applicative f =>
(ClientList -> f ClientList) -> DhtState -> f DhtState
traverseClientLists
  closeNodes :: PublicKey -> DhtState -> [(Distance, NodeInfo)]
closeNodes = PublicKey -> DhtState -> [(Distance, NodeInfo)]
closeNodes

takeClosestNodesTo :: Int -> PublicKey -> DhtState -> [ NodeInfo ]
takeClosestNodesTo :: Int -> PublicKey -> DhtState -> [NodeInfo]
takeClosestNodesTo Int
n PublicKey
publicKey = ((Distance, NodeInfo) -> NodeInfo)
-> [(Distance, NodeInfo)] -> [NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Distance, NodeInfo) -> NodeInfo
forall a b. (a, b) -> b
snd ([(Distance, NodeInfo)] -> [NodeInfo])
-> (DhtState -> [(Distance, NodeInfo)]) -> DhtState -> [NodeInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Distance, NodeInfo)] -> [(Distance, NodeInfo)]
forall a. Int -> [a] -> [a]
take Int
n ([(Distance, NodeInfo)] -> [(Distance, NodeInfo)])
-> (DhtState -> [(Distance, NodeInfo)])
-> DhtState
-> [(Distance, NodeInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> DhtState -> [(Distance, NodeInfo)]
closeNodes PublicKey
publicKey

mapBuckets :: (KBuckets -> KBuckets) -> DhtState -> DhtState
mapBuckets :: (KBuckets -> KBuckets) -> DhtState -> DhtState
mapBuckets KBuckets -> KBuckets
f dhtState :: DhtState
dhtState@DhtState { KBuckets
dhtCloseList :: KBuckets
dhtCloseList :: DhtState -> KBuckets
dhtCloseList } =
  DhtState
dhtState
    { dhtCloseList :: KBuckets
dhtCloseList = KBuckets -> KBuckets
f KBuckets
dhtCloseList
    }

mapSearchEntry :: (DhtSearchEntry -> DhtSearchEntry) -> DhtState -> DhtState
mapSearchEntry :: (DhtSearchEntry -> DhtSearchEntry) -> DhtState -> DhtState
mapSearchEntry DhtSearchEntry -> DhtSearchEntry
f dhtState :: DhtState
dhtState@DhtState { Map PublicKey DhtSearchEntry
dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList :: DhtState -> Map PublicKey DhtSearchEntry
dhtSearchList } =
  DhtState
dhtState
    { dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList = (DhtSearchEntry -> DhtSearchEntry)
-> Map PublicKey DhtSearchEntry -> Map PublicKey DhtSearchEntry
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map DhtSearchEntry -> DhtSearchEntry
f Map PublicKey DhtSearchEntry
dhtSearchList
    }

mapSearchClientLists :: (ClientList -> ClientList) -> DhtState -> DhtState
mapSearchClientLists :: (ClientList -> ClientList) -> DhtState -> DhtState
mapSearchClientLists ClientList -> ClientList
f =
    (DhtSearchEntry -> DhtSearchEntry) -> DhtState -> DhtState
mapSearchEntry ((DhtSearchEntry -> DhtSearchEntry) -> DhtState -> DhtState)
-> (DhtSearchEntry -> DhtSearchEntry) -> DhtState -> DhtState
forall a b. (a -> b) -> a -> b
$ \entry :: DhtSearchEntry
entry@DhtSearchEntry{ ClientList
searchClientList :: ClientList
searchClientList :: DhtSearchEntry -> ClientList
searchClientList } ->
      DhtSearchEntry
entry { searchClientList :: ClientList
searchClientList = ClientList -> ClientList
f ClientList
searchClientList }

updateSearchNode :: PublicKey -> Maybe NodeInfo -> DhtState -> DhtState
updateSearchNode :: PublicKey -> Maybe NodeInfo -> DhtState -> DhtState
updateSearchNode PublicKey
publicKey Maybe NodeInfo
nodeInfo dhtState :: DhtState
dhtState@DhtState { Map PublicKey DhtSearchEntry
dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList :: DhtState -> Map PublicKey DhtSearchEntry
dhtSearchList } =
  DhtState
dhtState
    { dhtSearchList :: Map PublicKey DhtSearchEntry
dhtSearchList = (DhtSearchEntry -> DhtSearchEntry)
-> PublicKey
-> Map PublicKey DhtSearchEntry
-> Map PublicKey DhtSearchEntry
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust DhtSearchEntry -> DhtSearchEntry
update PublicKey
publicKey Map PublicKey DhtSearchEntry
dhtSearchList
    }
  where
    update :: DhtSearchEntry -> DhtSearchEntry
update DhtSearchEntry
entry = DhtSearchEntry
entry { searchNode :: Maybe NodeInfo
searchNode = Maybe NodeInfo
nodeInfo }

\end{code}

Removing a node info from the state removes it from all k-buckets. If a search
entry for the removed node's public key existed, the node info in that search
entry is unset. The search entry itself is not removed.

\begin{code}

containsNode :: PublicKey -> DhtState -> Bool
containsNode :: PublicKey -> DhtState -> Bool
containsNode PublicKey
publicKey =
  (Bool -> NodeInfo -> Bool) -> Bool -> DhtState -> Bool
forall l a. NodeList l => (a -> NodeInfo -> a) -> a -> l -> a
NodeList.foldNodes (\Bool
a NodeInfo
x -> Bool
a Bool -> Bool -> Bool
|| NodeInfo -> PublicKey
NodeInfo.publicKey NodeInfo
x PublicKey -> PublicKey -> Bool
forall a. Eq a => a -> a -> Bool
== PublicKey
publicKey) Bool
False


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


instance Arbitrary DhtState where
  arbitrary :: Gen DhtState
arbitrary =
    Timestamp
-> KeyPair
-> [(Timestamp, NodeInfo)]
-> [(Timestamp, PublicKey)]
-> DhtState
initialise (Timestamp
 -> KeyPair
 -> [(Timestamp, NodeInfo)]
 -> [(Timestamp, PublicKey)]
 -> DhtState)
-> Gen Timestamp
-> Gen
     (KeyPair
      -> [(Timestamp, NodeInfo)] -> [(Timestamp, PublicKey)] -> DhtState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Timestamp
forall a. Arbitrary a => Gen a
arbitrary Gen
  (KeyPair
   -> [(Timestamp, NodeInfo)] -> [(Timestamp, PublicKey)] -> DhtState)
-> Gen KeyPair
-> Gen
     ([(Timestamp, NodeInfo)] -> [(Timestamp, PublicKey)] -> DhtState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen KeyPair
forall a. Arbitrary a => Gen a
arbitrary Gen
  ([(Timestamp, NodeInfo)] -> [(Timestamp, PublicKey)] -> DhtState)
-> Gen [(Timestamp, NodeInfo)]
-> Gen ([(Timestamp, PublicKey)] -> DhtState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [(Timestamp, NodeInfo)]
forall a. Arbitrary a => Gen a
arbitrary Gen ([(Timestamp, PublicKey)] -> DhtState)
-> Gen [(Timestamp, PublicKey)] -> Gen DhtState
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [(Timestamp, PublicKey)]
forall a. Arbitrary a => Gen a
arbitrary
    where
      initialise :: Timestamp -> KeyPair -> [(Timestamp, NodeInfo)] -> [(Timestamp, PublicKey)] -> DhtState
      initialise :: Timestamp
-> KeyPair
-> [(Timestamp, NodeInfo)]
-> [(Timestamp, PublicKey)]
-> DhtState
initialise Timestamp
time KeyPair
kp [(Timestamp, NodeInfo)]
nis =
        (DhtState -> (Timestamp, PublicKey) -> DhtState)
-> DhtState -> [(Timestamp, PublicKey)] -> DhtState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Timestamp, PublicKey) -> DhtState -> DhtState)
-> DhtState -> (Timestamp, PublicKey) -> DhtState
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Timestamp, PublicKey) -> DhtState -> DhtState)
 -> DhtState -> (Timestamp, PublicKey) -> DhtState)
-> ((Timestamp, PublicKey) -> DhtState -> DhtState)
-> DhtState
-> (Timestamp, PublicKey)
-> DhtState
forall a b. (a -> b) -> a -> b
$ (Timestamp -> PublicKey -> DhtState -> DhtState)
-> (Timestamp, PublicKey) -> DhtState -> DhtState
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Timestamp -> PublicKey -> DhtState -> DhtState
addSearchKey) ((DhtState -> (Timestamp, NodeInfo) -> DhtState)
-> DhtState -> [(Timestamp, NodeInfo)] -> DhtState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Timestamp, NodeInfo) -> DhtState -> DhtState)
-> DhtState -> (Timestamp, NodeInfo) -> DhtState
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Timestamp, NodeInfo) -> DhtState -> DhtState)
 -> DhtState -> (Timestamp, NodeInfo) -> DhtState)
-> ((Timestamp, NodeInfo) -> DhtState -> DhtState)
-> DhtState
-> (Timestamp, NodeInfo)
-> DhtState
forall a b. (a -> b) -> a -> b
$ (Timestamp -> NodeInfo -> DhtState -> DhtState)
-> (Timestamp, NodeInfo) -> DhtState -> DhtState
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Timestamp -> NodeInfo -> DhtState -> DhtState
forall l. NodeList l => Timestamp -> NodeInfo -> l -> l
NodeList.addNode) (Timestamp -> KeyPair -> DhtState
empty Timestamp
time KeyPair
kp) [(Timestamp, NodeInfo)]
nis)

  shrink :: DhtState -> [DhtState]
shrink DhtState
dhtState =
    Maybe DhtState -> [DhtState]
forall a. Maybe a -> [a]
Maybe.maybeToList Maybe DhtState
shrunkNode [DhtState] -> [DhtState] -> [DhtState]
forall a. [a] -> [a] -> [a]
++ Maybe DhtState -> [DhtState]
forall a. Maybe a -> [a]
Maybe.maybeToList Maybe DhtState
forall a. Maybe a
shrunkSearchKey
    where
      -- Remove the first node we can find in the state.
      shrunkNode :: Maybe DhtState
shrunkNode = do
        PublicKey
firstPK <- NodeInfo -> PublicKey
NodeInfo.publicKey (NodeInfo -> PublicKey) -> Maybe NodeInfo -> Maybe PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe NodeInfo -> NodeInfo -> Maybe NodeInfo)
-> Maybe NodeInfo -> DhtState -> Maybe NodeInfo
forall l a. NodeList l => (a -> NodeInfo -> a) -> a -> l -> a
NodeList.foldNodes (\Maybe NodeInfo
a NodeInfo
x -> Maybe NodeInfo
a Maybe NodeInfo -> Maybe NodeInfo -> Maybe NodeInfo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NodeInfo -> Maybe NodeInfo
forall a. a -> Maybe a
Just NodeInfo
x) Maybe NodeInfo
forall a. Maybe a
Nothing DhtState
dhtState
        DhtState -> Maybe DhtState
forall (m :: * -> *) a. Monad m => a -> m a
return (DhtState -> Maybe DhtState) -> DhtState -> Maybe DhtState
forall a b. (a -> b) -> a -> b
$ PublicKey -> DhtState -> DhtState
forall l. NodeList l => PublicKey -> l -> l
NodeList.removeNode PublicKey
firstPK DhtState
dhtState

      shrunkSearchKey :: Maybe a
shrunkSearchKey = Maybe a
forall a. Maybe a
Nothing

\end{code}