diff options
Diffstat (limited to 'Kademlia.hs')
-rw-r--r-- | Kademlia.hs | 32 |
1 files changed, 21 insertions, 11 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 | |||
111 | , reportPingResult = \tm ni b -> reportPingResult ir tm (f ni) b | 111 | , reportPingResult = \tm ni b -> reportPingResult ir tm (f ni) b |
112 | } | 112 | } |
113 | 113 | ||
114 | data KademliaSpace nid ni = KademliaSpace | ||
115 | { kademliaLocation :: ni -> nid | ||
116 | , kademliaTestBit :: nid -> Word -> Bool | ||
117 | } | ||
118 | |||
119 | contramapKS f ks = ks | ||
120 | { kademliaLocation = kademliaLocation ks . f | ||
121 | } | ||
122 | |||
123 | -- | All the IO operations neccessary to maintain a Kademlia routing table. | 114 | -- | All the IO operations neccessary to maintain a Kademlia routing table. |
124 | data TableStateIO nid ni = TableStateIO | 115 | data TableStateIO nid ni = TableStateIO |
125 | { -- | Write the routing table. Typically 'writeTVar'. | 116 | { -- | Write the routing table. Typically 'writeTVar'. |
@@ -145,10 +136,29 @@ data TableStateIO nid ni = TableStateIO | |||
145 | , tblChanged :: RoutingTableChanged ni -> STM (IO ()) | 136 | , tblChanged :: RoutingTableChanged ni -> STM (IO ()) |
146 | } | 137 | } |
147 | 138 | ||
139 | vanillaIO :: TVar (Table ni nid) -> (ni -> IO Bool) -> TableStateIO nid ni | ||
140 | vanillaIO var ping = TableStateIO | ||
141 | { tblRead = readTVar var | ||
142 | , tblWrite = writeTVar var | ||
143 | , tblPing = ping | ||
144 | , tblChanged = const $ return $ return () | ||
145 | } | ||
146 | |||
147 | -- | Everything neccessary to maintain a routing table of /ni/ (node | ||
148 | -- information) entries. | ||
148 | data Kademlia nid ni = Kademlia (InsertionReporter ni) | 149 | data Kademlia nid ni = Kademlia (InsertionReporter ni) |
149 | (KademliaSpace nid ni) | 150 | (KademliaSpace nid ni) |
150 | (TableStateIO nid ni) | 151 | (TableStateIO nid ni) |
151 | 152 | ||
153 | {- | ||
154 | kademlia :: FiniteBits nid => | ||
155 | TVar (Table nid nid) -> (nid -> IO Bool) -> Kademlia nid nid | ||
156 | kademlia var ping = Kademlia quietInsertions | ||
157 | (KademliaSpace id testIdBit) | ||
158 | (vanillaIO var ping) | ||
159 | |||
160 | -} | ||
161 | |||
152 | insertNode :: | 162 | insertNode :: |
153 | forall ni nid. Ord ni => | 163 | forall ni nid. Ord ni => |
154 | Kademlia nid ni | 164 | Kademlia nid ni |
@@ -160,7 +170,7 @@ insertNode (Kademlia reporter space io) node = do | |||
160 | 170 | ||
161 | (ps,reaction) <- atomically $ do | 171 | (ps,reaction) <- atomically $ do |
162 | tbl <- tblRead io | 172 | tbl <- tblRead io |
163 | let (inserted, ps,t') = R.updateForInbound (kademliaTestBit space) (kademliaLocation space) tm node tbl | 173 | let (inserted, ps,t') = R.updateForInbound space tm node tbl |
164 | tblWrite io t' | 174 | tblWrite io t' |
165 | reaction <- if inserted | 175 | reaction <- if inserted |
166 | then tblChanged io $ RoutingTableChanged Nothing node tm | 176 | then tblChanged io $ RoutingTableChanged Nothing node tm |
@@ -177,7 +187,7 @@ insertNode (Kademlia reporter space io) node = do | |||
177 | reportPingResult reporter tm n b | 187 | reportPingResult reporter tm n b |
178 | join $ atomically $ do | 188 | join $ atomically $ do |
179 | tbl <- tblRead io | 189 | tbl <- tblRead io |
180 | let (replacements, t') = R.updateForPingResult (kademliaTestBit space) (kademliaLocation space) n b tbl | 190 | let (replacements, t') = R.updateForPingResult space n b tbl |
181 | tblWrite io t' | 191 | tblWrite io t' |
182 | sequence <$> mapM (\(x,(t,y)) -> tblChanged io $ RoutingTableChanged (Just x) y t) | 192 | sequence <$> mapM (\(x,(t,y)) -> tblChanged io $ RoutingTableChanged (Just x) y t) |
183 | replacements | 193 | replacements |