diff options
author | joe <joe@jerkface.net> | 2017-07-17 19:31:30 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-07-17 19:31:30 -0400 |
commit | 00bbd3607de269ffcd30c42875ea02ca48da44ff (patch) | |
tree | d9f61422f25b1fac4c08b2bf16aca9aa6a835d46 /Kademlia.hs | |
parent | 01faa099bd7e98137ef2897d5279ea077c75c4a0 (diff) |
Represent RoutingStatus as 3 states: Stranger,Applicant, and Accepted.
Diffstat (limited to 'Kademlia.hs')
-rw-r--r-- | Kademlia.hs | 56 |
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 | |||
26 | import Data.Time.Clock.POSIX (POSIXTime) | 26 | import Data.Time.Clock.POSIX (POSIXTime) |
27 | 27 | ||
28 | 28 | ||
29 | -- | The status of a given node with respect to a given routint table. | ||
30 | data RoutingStatus | ||
31 | = Stranger -- ^ The node is unknown to the Kademlia routing table. | ||
32 | | Applicant -- ^ The node may be inserted pending a ping timeout. | ||
33 | | Accepted -- ^ The node has a slot in one of the Kademlia buckets. | ||
34 | deriving (Eq,Ord,Enum,Show,Read) | ||
35 | |||
29 | -- | A change occured in the kademlia routing table. | 36 | -- | A change occured in the kademlia routing table. |
30 | data RoutingTableChanged ni = RoutingTableChanged | 37 | data RoutingTransition ni = RoutingTransition |
31 | { nodeReplaced :: !(Maybe ni) -- Deleted entry. | 38 | { transitioningNode :: ni |
32 | , nodeInserted :: ni -- New routing table entry. | 39 | , transitionedTo :: !RoutingStatus |
33 | , nodeTimestamp :: !POSIXTime -- Last-seen time for the new node. | ||
34 | } | 40 | } |
35 | deriving (Eq,Ord,Show,Functor,Foldable,Traversable) | 41 | deriving (Eq,Ord,Show,Read) |
36 | 42 | ||
37 | data InsertionReporter ni = InsertionReporter | 43 | data InsertionReporter ni = InsertionReporter |
38 | { -- | Called on every inbound packet. | 44 | { -- | Called on every inbound packet. |
@@ -78,8 +84,8 @@ data TableStateIO nid ni = TableStateIO | |||
78 | -- It is not necessary to do anything interesting here. The following | 84 | -- It is not necessary to do anything interesting here. The following |
79 | -- trivial implementation is fine: | 85 | -- trivial implementation is fine: |
80 | -- | 86 | -- |
81 | -- > tblChanged = const $ return $ return () | 87 | -- > tblTransition = const $ return $ return () |
82 | , tblChanged :: RoutingTableChanged ni -> STM (IO ()) | 88 | , tblTransition :: RoutingTransition ni -> STM (IO ()) |
83 | } | 89 | } |
84 | 90 | ||
85 | vanillaIO :: TVar (BucketList ni) -> (ni -> IO Bool) -> TableStateIO nid ni | 91 | vanillaIO :: TVar (BucketList ni) -> (ni -> IO Bool) -> TableStateIO nid ni |
@@ -87,7 +93,7 @@ vanillaIO var ping = TableStateIO | |||
87 | { tblRead = readTVar var | 93 | { tblRead = readTVar var |
88 | , tblWrite = writeTVar var | 94 | , tblWrite = writeTVar var |
89 | , tblPing = ping | 95 | , tblPing = ping |
90 | , tblChanged = const $ return $ return () | 96 | , tblTransition = const $ return $ return () |
91 | } | 97 | } |
92 | 98 | ||
93 | -- | Everything neccessary to maintain a routing table of /ni/ (node | 99 | -- | Everything neccessary to maintain a routing table of /ni/ (node |
@@ -96,6 +102,25 @@ data Kademlia nid ni = Kademlia (InsertionReporter ni) | |||
96 | (KademliaSpace nid ni) | 102 | (KademliaSpace nid ni) |
97 | (TableStateIO nid ni) | 103 | (TableStateIO nid ni) |
98 | 104 | ||
105 | |||
106 | -- Helper to 'insertNode'. | ||
107 | -- | ||
108 | -- Adapt return value from 'updateForPingResult' into a | ||
109 | -- more easily groked list of transitions. | ||
110 | transition :: (ni,Maybe (t,ni)) -> [RoutingTransition ni] | ||
111 | transition (x,m) = | ||
112 | -- | Just _ <- m = Node transition: Accepted --> Stranger | ||
113 | -- | Nothing <- m = Node transition: Applicant --> Stranger | ||
114 | RoutingTransition x Stranger | ||
115 | : maybeToList (accepted <$> m) | ||
116 | |||
117 | -- Helper to 'transition' | ||
118 | -- | ||
119 | -- Node transition: Applicant --> Accepted | ||
120 | accepted :: (t,ni) -> RoutingTransition ni | ||
121 | accepted (_,y) = RoutingTransition y Accepted | ||
122 | |||
123 | |||
99 | insertNode :: Kademlia nid ni -> ni -> IO () | 124 | insertNode :: Kademlia nid ni -> ni -> IO () |
100 | insertNode (Kademlia reporter space io) node = do | 125 | insertNode (Kademlia reporter space io) node = do |
101 | 126 | ||
@@ -105,9 +130,12 @@ insertNode (Kademlia reporter space io) node = do | |||
105 | tbl <- tblRead io | 130 | tbl <- tblRead io |
106 | let (inserted, ps,t') = R.updateForInbound space tm node tbl | 131 | let (inserted, ps,t') = R.updateForInbound space tm node tbl |
107 | tblWrite io t' | 132 | tblWrite io t' |
108 | reaction <- if inserted | 133 | reaction <- case ps of |
109 | then tblChanged io $ RoutingTableChanged Nothing node tm | 134 | _ | inserted -> -- Node transition: Stranger --> Accepted |
110 | else return $ return () | 135 | tblTransition io $ RoutingTransition node Accepted |
136 | (_:_) -> -- Node transition: Stranger --> Applicant | ||
137 | tblTransition io $ RoutingTransition node Applicant | ||
138 | _ -> return $ return () | ||
111 | return (ps, reaction) | 139 | return (ps, reaction) |
112 | 140 | ||
113 | reportArrival reporter tm node ps | 141 | reportArrival reporter tm node ps |
@@ -122,7 +150,9 @@ insertNode (Kademlia reporter space io) node = do | |||
122 | tbl <- tblRead io | 150 | tbl <- tblRead io |
123 | let (replacements, t') = R.updateForPingResult space n b tbl | 151 | let (replacements, t') = R.updateForPingResult space n b tbl |
124 | tblWrite io t' | 152 | tblWrite io t' |
125 | sequence <$> mapM (\(x,(t,y)) -> tblChanged io $ RoutingTableChanged (Just x) y t) | 153 | ios <- sequence $ concatMap |
126 | replacements | 154 | (map (tblTransition io) . transition) |
155 | replacements | ||
156 | return $ sequence_ ios | ||
127 | 157 | ||
128 | return () | 158 | return () |