Refactoring.

2 files changed, 49 insertions, 25 deletions

diff --git a/Kademlia.hs b/Kademlia.hs
index 40874078..7bffe4c1 100644
--- a/Kademlia.hs
+++ b/Kademlia.hs
@@ -111,15 +111,6 @@ contramapIR f ir = InsertionReporter
     , reportPingResult = \tm ni b -> reportPingResult ir tm (f ni) b
     }
 
-data KademliaSpace nid ni = KademliaSpace
-    { kademliaLocation :: ni -> nid
-    , kademliaTestBit :: nid -> Word -> Bool
-    }
-
-contramapKS f ks = ks
-    { kademliaLocation = kademliaLocation ks . f
-    }
-
 -- | All the IO operations neccessary to maintain a Kademlia routing table.
 data TableStateIO nid ni = TableStateIO
     { -- | Write the routing table.  Typically 'writeTVar'.
@@ -145,10 +136,29 @@ data TableStateIO nid ni = TableStateIO
     , tblChanged :: RoutingTableChanged ni -> STM (IO ())
     }
 
+vanillaIO :: TVar (Table ni nid) -> (ni -> IO Bool) -> TableStateIO nid ni
+vanillaIO var ping = TableStateIO
+    { tblRead = readTVar var
+    , tblWrite = writeTVar var
+    , tblPing = ping
+    , tblChanged = const $ return $ return ()
+    }
+
+-- | Everything neccessary to maintain a routing table of /ni/ (node
+-- information) entries.
 data Kademlia nid ni = Kademlia (InsertionReporter ni)
                                 (KademliaSpace nid ni)
                                 (TableStateIO nid ni)
 
+{-
+kademlia :: FiniteBits nid =>
+            TVar (Table nid nid) -> (nid -> IO Bool) -> Kademlia nid nid
+kademlia var ping = Kademlia quietInsertions
+                             (KademliaSpace id testIdBit)
+                             (vanillaIO var ping)
+
+-}
+
 insertNode ::
     forall ni nid.  Ord ni =>
     Kademlia nid ni
@@ -160,7 +170,7 @@ insertNode (Kademlia reporter space io) node = do
 
   (ps,reaction) <- atomically $ do
     tbl <- tblRead io
-    let (inserted, ps,t') = R.updateForInbound (kademliaTestBit space) (kademliaLocation space) tm node tbl
+    let (inserted, ps,t') = R.updateForInbound space tm node tbl
     tblWrite io t'
     reaction <- if inserted
                     then tblChanged io $ RoutingTableChanged Nothing node tm
@@ -177,7 +187,7 @@ insertNode (Kademlia reporter space io) node = do
         reportPingResult reporter tm n b
         join $ atomically $ do
             tbl <- tblRead io
-            let (replacements, t') = R.updateForPingResult (kademliaTestBit space) (kademliaLocation space) n b tbl
+            let (replacements, t') = R.updateForPingResult space n b tbl
             tblWrite io t'
             sequence <$> mapM (\(x,(t,y)) -> tblChanged io $ RoutingTableChanged (Just x) y t)
                               replacements
diff --git a/src/Network/DHT/Routing.hs b/src/Network/DHT/Routing.hs
index 7f0e1c94..e2bc5aa9 100644
--- a/src/Network/DHT/Routing.hs
+++ b/src/Network/DHT/Routing.hs
@@ -638,33 +638,33 @@ deriving instance ( Show ip
 --  [ /tbl'/ ]         The updated routing 'Table'.
 --
 updateForInbound :: Ord ni =>
-    (nid -> Word -> Bool)
-    -> (ni -> nid)
+    KademliaSpace nid ni
     -> Timestamp -> ni -> Table ni nid -> (Bool, [ni], Table ni nid)
-updateForInbound testIdBit nodeId tm ni tbl =
+updateForInbound space tm ni tbl =
     maybe (False, [],tbl) (\(ps,tbl') -> (True, ps, tbl'))
-                   $ modifyBucket testIdBit (\ni -> testIdBit $ nodeId ni)
-                                            (nodeId ni)
-                                            (updateBucketForInbound tm ni)
-                                            tbl
+                   $ modifyBucket (kademliaTestBit space)
+                                   (\ni -> kademliaTestBit space $ kademliaLocation space ni)
+                                   (kademliaLocation space ni)
+                                   (updateBucketForInbound tm ni)
+                                   tbl
 
 -- | Update the routing table with the results of a ping.
 --
 -- Each (a,(tm,b)) in the returned list indicates that the node /a/ was deleted from the
 -- routing table and the  node /b/, with timestamp /tm/, has taken its place.
 updateForPingResult :: Ord ni =>
-    (nid -> Word -> Bool)
-    -> (ni -> nid)
+    KademliaSpace nid ni
     -> ni           -- ^ The pinged node.
     -> Bool         -- ^ True if we got a reply, False if it timed out.
     -> Table ni nid -- ^ The routing table.
     -> ( [(ni,(Timestamp, ni))], Table ni nid )
-updateForPingResult testIdBit nodeId ni got_reply tbl =
+updateForPingResult space ni got_reply tbl =
     fromMaybe ([],tbl)
-                   $ modifyBucket testIdBit (\ni -> testIdBit $ nodeId ni)
-                                            (nodeId ni)
-                                            (updateBucketForPingResult ni got_reply)
-                                            tbl
+                   $ modifyBucket (kademliaTestBit space)
+                                  (\ni -> kademliaTestBit space $ kademliaLocation space ni)
+                                  (kademliaLocation space ni)
+                                  (updateBucketForPingResult ni got_reply)
+                                  tbl
 
 
 {-----------------------------------------------------------------------
@@ -685,3 +685,17 @@ toBucketList (One   b t) = b : toBucketList t
 toList :: Table ni nid -> [[TableEntry ni]]
 toList = L.map (L.map tableEntry . PSQ.toList . bktNodes) . toBucketList
 
+data KademliaSpace nid ni = KademliaSpace
+    { -- | Given a node record (probably including IP address), yields a
+      -- kademlia xor-metric location.
+      kademliaLocation :: ni -> nid
+      -- | Used when comparing locations.  This is similar to
+      -- 'Data.Bits.testBit' except that the ordering of bits is reversed, so
+      -- that 0 is the most significant bit.
+    , kademliaTestBit :: nid -> Word -> Bool
+    }
+
+contramapKS f ks = ks
+    { kademliaLocation = kademliaLocation ks . f
+    }
+