summaryrefslogtreecommitdiff
path: root/Kademlia.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Kademlia.hs')
-rw-r--r--Kademlia.hs32
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
114data KademliaSpace nid ni = KademliaSpace
115 { kademliaLocation :: ni -> nid
116 , kademliaTestBit :: nid -> Word -> Bool
117 }
118
119contramapKS 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.
124data TableStateIO nid ni = TableStateIO 115data 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
139vanillaIO :: TVar (Table ni nid) -> (ni -> IO Bool) -> TableStateIO nid ni
140vanillaIO 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.
148data Kademlia nid ni = Kademlia (InsertionReporter ni) 149data 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{-
154kademlia :: FiniteBits nid =>
155 TVar (Table nid nid) -> (nid -> IO Bool) -> Kademlia nid nid
156kademlia var ping = Kademlia quietInsertions
157 (KademliaSpace id testIdBit)
158 (vanillaIO var ping)
159
160-}
161
152insertNode :: 162insertNode ::
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