1 files changed, 43 insertions, 13 deletions

diff --git a/Kademlia.hs b/Kademlia.hs
index 0caba720..c8eb2b93 100644
--- a/Kademlia.hs
+++ b/Kademlia.hs
@@ -26,13 +26,19 @@ import Data.Monoid
 import Data.Time.Clock.POSIX (POSIXTime)
 
 
+-- | The status of a given node with respect to a given routint table.
+data RoutingStatus
+    = Stranger  -- ^ The node is unknown to the Kademlia routing table.
+    | Applicant -- ^ The node may be inserted pending a ping timeout.
+    | Accepted  -- ^ The node has a slot in one of the Kademlia buckets.
+    deriving (Eq,Ord,Enum,Show,Read)
+
 -- | A change occured in the kademlia routing table.
-data RoutingTableChanged ni = RoutingTableChanged
-    { nodeReplaced :: !(Maybe ni) -- Deleted entry.
-    , nodeInserted :: ni          -- New routing table entry.
-    , nodeTimestamp :: !POSIXTime -- Last-seen time for the new node.
+data RoutingTransition ni = RoutingTransition
+    { transitioningNode :: ni
+    , transitionedTo    :: !RoutingStatus
     }
- deriving (Eq,Ord,Show,Functor,Foldable,Traversable)
+    deriving (Eq,Ord,Show,Read)
 
 data InsertionReporter ni = InsertionReporter
     { -- | Called on every inbound packet.
@@ -78,8 +84,8 @@ data TableStateIO nid ni = TableStateIO
       -- It is not necessary to do anything interesting here.  The following
       -- trivial implementation is fine:
       --
-      -- > tblChanged = const $ return $ return ()
-    , tblChanged :: RoutingTableChanged ni -> STM (IO ())
+      -- > tblTransition = const $ return $ return ()
+    , tblTransition :: RoutingTransition ni -> STM (IO ())
     }
 
 vanillaIO :: TVar (BucketList ni) -> (ni -> IO Bool) -> TableStateIO nid ni
@@ -87,7 +93,7 @@ vanillaIO var ping = TableStateIO
     { tblRead    = readTVar var
     , tblWrite   = writeTVar var
     , tblPing    = ping
-    , tblChanged = const $ return $ return ()
+    , tblTransition = const $ return $ return ()
     }
 
 -- | Everything neccessary to maintain a routing table of /ni/ (node
@@ -96,6 +102,25 @@ data Kademlia nid ni = Kademlia (InsertionReporter ni)
                                 (KademliaSpace nid ni)
                                 (TableStateIO nid ni)
 
+
+-- Helper to 'insertNode'.
+--
+-- Adapt return value from 'updateForPingResult' into a
+-- more easily groked list of transitions.
+transition :: (ni,Maybe (t,ni)) -> [RoutingTransition ni]
+transition (x,m) =
+    -- | Just _  <- m  =  Node transition:  Accepted  --> Stranger
+    -- | Nothing <- m  =  Node transition:  Applicant --> Stranger
+    RoutingTransition x Stranger
+       : maybeToList (accepted <$> m)
+
+-- Helper to 'transition'
+--
+-- Node transition: Applicant --> Accepted
+accepted :: (t,ni) -> RoutingTransition ni
+accepted (_,y) = RoutingTransition y Accepted
+
+
 insertNode :: Kademlia nid ni -> ni -> IO ()
 insertNode (Kademlia reporter space io) node = do
 
@@ -105,9 +130,12 @@ insertNode (Kademlia reporter space io) node = do
     tbl <- tblRead io
     let (inserted, ps,t') = R.updateForInbound space tm node tbl
     tblWrite io t'
-    reaction <- if inserted
-                    then tblChanged io $ RoutingTableChanged Nothing node tm
-                    else return $ return ()
+    reaction <- case ps of
+        _ | inserted -> -- Node transition: Stranger --> Accepted
+                        tblTransition io $ RoutingTransition node Accepted 
+        (_:_)        ->  -- Node transition: Stranger --> Applicant
+                        tblTransition io $ RoutingTransition node Applicant
+        _            -> return $ return ()
     return (ps, reaction)
 
   reportArrival reporter tm node ps
@@ -122,7 +150,9 @@ insertNode (Kademlia reporter space io) node = do
             tbl <- tblRead io
             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
+            ios <- sequence $ concatMap
+                                (map (tblTransition io) . transition)
+                                replacements
+            return $ sequence_ ios
 
   return ()