From e22ca7f163b6b771a570013d506f5d5f6576c2aa Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sat, 1 Jul 2017 11:18:04 -0400
Subject: Simplified Kademlia class.

---
 src/Network/DHT/Mainline.hs | 14 +-------------
 src/Network/DHT/Types.hs    | 43 ++++++++++++++++++++++++++++++-------------
 2 files changed, 31 insertions(+), 26 deletions(-)

(limited to 'src/Network/DHT')

diff --git a/src/Network/DHT/Mainline.hs b/src/Network/DHT/Mainline.hs
index b756ff6a..6ef6d450 100644
--- a/src/Network/DHT/Mainline.hs
+++ b/src/Network/DHT/Mainline.hs
@@ -438,7 +438,7 @@ data Announced = Announced
   deriving (Show, Eq, Typeable)
 
 instance BEncode Announced where
-  toBEncode   _ = toBEncode Ping
+  toBEncode   _ = toBEncode ( Ping :: Ping KMessageOf )
   fromBEncode _ = pure  Announced
 
 -- | \"q" = \"announce\"
@@ -536,23 +536,11 @@ checkToken sessionTokens addr questionableToken = do
 
 
 instance Kademlia KMessageOf where
-    data Ping KMessageOf = Ping
-      deriving (Show, Eq, Typeable)
-    newtype FindNode KMessageOf ip = FindNode (NodeId KMessageOf)
-      deriving (Show, Eq, Typeable)
-    newtype NodeFound KMessageOf ip = NodeFound [NodeInfo KMessageOf ip ()]
-      deriving (Show, Eq, Typeable)
     data DHTData KMessageOf ip = TorrentData
             { contactInfo   :: !(TVar    (PeerStore ip     )) -- ^ published by other nodes;
             , sessionTokens :: !(TVar     SessionTokens     ) -- ^ query session IDs.
             }
 
-    pingMessage _ = Ping
-    pongMessage _ = Ping
-    findNodeMessage _ k = FindNode (toNodeId k)
-    findWho (FindNode nid) = nid
-    foundNodes (NodeFound ns) = ns
-    foundNodesMessage ns = NodeFound ns
 
     dhtAdjustID _ fallback ip0 arrival
             = fromMaybe fallback $ do
diff --git a/src/Network/DHT/Types.hs b/src/Network/DHT/Types.hs
index 31ae5948..91d1fc22 100644
--- a/src/Network/DHT/Types.hs
+++ b/src/Network/DHT/Types.hs
@@ -44,22 +44,39 @@ data Response dht a = Response
 deriving instance (Eq (NodeId dht), Eq a ) => Eq (Response dht a)
 deriving instance (Show (NodeId dht), Show a ) => Show (Response dht a)
 
+-- | The most basic query is a ping. Ping query is used to check if a
+-- quered node is still alive.
+data Ping ( dht :: * -> *) = Ping
+  deriving (Show, Eq, Typeable)
+-- | Find node is used to find the contact information for a node
+-- given its ID.
+newtype FindNode dht ip = FindNode (NodeId dht)
+  deriving (Typeable)
+newtype NodeFound dht ip = NodeFound [NodeInfo dht ip ()]
+  deriving (Typeable)
+
+deriving instance Eq (NodeId dht) => Eq (FindNode dht ip)
+deriving instance Eq (NodeId dht) => Eq (NodeFound dht ip)
+deriving instance Show (NodeId dht) => Show (FindNode dht ip)
+deriving instance ( Show (NodeId dht)
+                  , Show ip
+                  ) => Show (NodeFound dht ip)
+
+pingMessage :: Proxy dht -> Ping dht
+pingMessage _ = Ping
+pongMessage :: Proxy dht -> Ping dht
+pongMessage _ = Ping
+findNodeMessage :: TableKey dht k => Proxy dht -> k -> FindNode dht ip
+findNodeMessage _ k = FindNode (toNodeId k)
+foundNodesMessage :: [NodeInfo dht ip ()] -> NodeFound dht ip
+findWho (FindNode nid) = nid
+foundNodes :: NodeFound dht ip -> [NodeInfo dht ip ()]
+foundNodes (NodeFound ns) = ns
+findWho :: FindNode dht ip -> NodeId dht
+foundNodesMessage ns = NodeFound ns
 
 class Kademlia dht where
-    -- | The most basic query is a ping. Ping query is used to check if a
-    -- quered node is still alive.
-    data Ping dht
-    -- | Find node is used to find the contact information for a node
-    -- given its ID.
-    data FindNode dht ip
-    data NodeFound dht ip
     data DHTData dht ip
-    pingMessage :: Proxy dht -> Ping dht
-    pongMessage :: Proxy dht -> Ping dht
-    findNodeMessage :: TableKey dht k => Proxy dht -> k -> FindNode dht ip
-    foundNodesMessage :: [NodeInfo dht ip ()] -> NodeFound dht ip
-    foundNodes :: NodeFound dht ip -> [NodeInfo dht ip ()]
-    findWho :: FindNode dht ip -> NodeId dht
     dhtAdjustID :: Address ip => Proxy dht -> NodeId dht -> SockAddr -> Event dht ip u -> NodeId dht
     namePing :: Proxy dht -> QueryMethod dht
     nameFindNodes :: Proxy dht -> QueryMethod dht
-- 
cgit v1.2.3