summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--SybilLimit.hs92
1 files changed, 63 insertions, 29 deletions
diff --git a/SybilLimit.hs b/SybilLimit.hs
index bb0a54f..91433ba 100644
--- a/SybilLimit.hs
+++ b/SybilLimit.hs
@@ -1,7 +1,9 @@
1{-# LANGUAGE StandaloneDeriving #-} 1{-# LANGUAGE StandaloneDeriving #-}
2module SybilLimit where 2module SybilLimit where
3 3
4import Data.List ( foldl' ) 4import Data.List ( foldl', minimumBy )
5import Data.Maybe ( fromMaybe )
6import Data.Ord ( comparing )
5import Data.IntMap.Strict ( IntMap, (!) ) 7import Data.IntMap.Strict ( IntMap, (!) )
6import qualified Data.IntMap.Strict as IntMap 8import qualified Data.IntMap.Strict as IntMap
7import Data.Traversable ( sequenceA ) 9import Data.Traversable ( sequenceA )
@@ -45,9 +47,9 @@ data FriendNode = FriendNode
45-- | When 'iPendingTails' is empty, the intersection condition is passed if and 47-- | When 'iPendingTails' is empty, the intersection condition is passed if and
46-- only if 'iVerifiedTails' is not empty. 48-- only if 'iVerifiedTails' is not empty.
47data PendingIntersection = PendingIntersection 49data PendingIntersection = PendingIntersection
48 { iSuspect :: NodeId 50 { iSuspect :: NodeId -- todo: neccessary?
49 , iPendingTails :: Map (NodeId,NodeId) () 51 , iPendingTails :: Map (NodeId,NodeId) [Int]
50 , iVerifiedTails :: Map (NodeId,NodeId) () 52 , iVerifiedTails :: Map (NodeId,NodeId) [Int]
51 } 53 }
52 54
53data PeerMessage 55data PeerMessage
@@ -63,13 +65,16 @@ data PeerMessage
63 , rrRegisteredFrom :: NodeId 65 , rrRegisteredFrom :: NodeId
64 , rrValidRegistration :: Bool } 66 , rrValidRegistration :: Bool }
65 67
66{-
67 | CredMessage SuspectCred
68 68
69data SuspectCred = SuspectCred { suspectId :: NodeId 69data SybilCheck
70 , suspectTails :: IntMap (NodeId,NodeId) } 70 = SybilCheck { chkSuspect :: NodeId
71 , chkAccepted :: Bool }
71 72
72-} 73data MessageReaction = MessageReaction
74 { changedState :: ThisNode
75 , outgoingMessages :: [(NodeId, PeerMessage)]
76 , sybilChecks :: [SybilCheck]
77 }
73 78
74friendNode :: NodeId -> FriendNode 79friendNode :: NodeId -> FriendNode
75friendNode nid = FriendNode nid IntMap.empty IntMap.empty Nothing 80friendNode nid = FriendNode nid IntMap.empty IntMap.empty Nothing
@@ -136,21 +141,34 @@ forwardMessage me next (srcId,msg) = msg'
136 destno = next (friends me ! srcno) ! rrRoute msg 141 destno = next (friends me ! srcno) ! rrRoute msg
137 dest = friendId (friends me ! destno) 142 dest = friendId (friends me ! destno)
138 143
139reactToMessage :: Int -> (NodeId,PeerMessage) -> ThisNode -> (ThisNode, [(NodeId,PeerMessage)]) 144reactToMessage :: Int -> (NodeId,PeerMessage) -> ThisNode -> MessageReaction
140reactToMessage w (srcId, msg@(RegistrationResponse {})) me = (me', []) 145reactToMessage w (srcId, msg@(RegistrationResponse {})) me =
146 MessageReaction me' [] sybils
141 where 147 where
142 me' = me { pendingVerifications = vs' } 148 me0 = me { pendingVerifications = vs' }
143 vs' :: Map NodeId PendingIntersection 149 vs' :: Map NodeId PendingIntersection
144 vs' = Map.adjust adj (rrSuspect msg) $ pendingVerifications me 150 vs' = Map.adjust adj (rrSuspect msg) $ pendingVerifications me
145 adj p = p { iPendingTails = Map.delete (rrRegisteredFrom msg, srcId) 151 tail = (rrRegisteredFrom msg, srcId)
146 $ iPendingTails p 152 adj p = p { iPendingTails = Map.delete tail $ iPendingTails p
147 , iVerifiedTails = 153 , iVerifiedTails =
148 if rrValidRegistration msg then v' else iVerifiedTails p 154 if rrValidRegistration msg then goodTail else iVerifiedTails p
149 } 155 }
150 where v' = Map.insert (rrRegisteredFrom msg, srcId) () 156 where goodTail = Map.insert tail indexes
151 $ iVerifiedTails p 157 $ iVerifiedTails p
152 158 indexes = fromMaybe [] $ Map.lookup tail $ iPendingTails p
153reactToMessage w (srcId, msg@(RegistrationQuery {})) me = (me, [(srcId,resp)]) 159 icheck = pendingVerifications me0 Map.! rrSuspect msg
160 (me',sybils) = if Map.null (iPendingTails icheck) then bcheck else (me0, [])
161 where bcheck = if Map.null (iVerifiedTails icheck)
162 then (me0, dishonest)
163 else balanceCheck
164 dishonest = [SybilCheck (rrSuspect msg) False]
165 indexes = fromMaybe [] $ Map.lookup tail $ iVerifiedTails icheck
166 balanceCheck = second chk $ balanceCondition tail indexes me0
167 where chk = (:[]) . SybilCheck (rrSuspect msg)
168 second f (x,y) = (x,f y)
169
170reactToMessage w (srcId, msg@(RegistrationQuery {})) me =
171 MessageReaction me [(srcId,resp)] []
154 where 172 where
155 resp = RegistrationResponse { rrSuspect = rrSuspect msg 173 resp = RegistrationResponse { rrSuspect = rrSuspect msg
156 , rrRegisteredFrom = rrRegisteredFrom msg 174 , rrRegisteredFrom = rrRegisteredFrom msg
@@ -159,13 +177,16 @@ reactToMessage w (srcId, msg@(RegistrationQuery {})) me = (me, [(srcId,resp)])
159 check = registeredTerminal (friends me ! key) == Just (rrSuspect msg) 177 check = registeredTerminal (friends me ! key) == Just (rrSuspect msg)
160 178
161reactToMessage w (srcId, msg) me = 179reactToMessage w (srcId, msg) me =
162 if rrCount msg == w then terminate else (me, [forwardMessage me next (srcId,msg)]) 180 if rrCount msg == w then terminate
181 else MessageReaction me [forwardMessage me next (srcId,msg)] []
163 where 182 where
164 (terminate,next) = case msg of 183 (terminate,next) = case msg of
165 ForwardRRMessage {} -> ( terminateForward, routesTo ) 184 ForwardRRMessage {} -> ( terminateForward, routesTo )
166 BackwardRRMessage {} -> ( terminateBackward, routesFrom ) 185 BackwardRRMessage {} -> ( terminateBackward, routesFrom )
167 186
168 terminateForward = ( me { friends = friends' }, [pong] ) 187 terminateForward = MessageReaction me { friends = friends' }
188 [pong]
189 []
169 where pong =( srcId, BackwardRRMessage { rrCount = 1 190 where pong =( srcId, BackwardRRMessage { rrCount = 1
170 , rrRoute = rrRoute msg 191 , rrRoute = rrRoute msg
171 , rrTail = (srcId, selfId me) 192 , rrTail = (srcId, selfId me)
@@ -174,18 +195,31 @@ reactToMessage w (srcId, msg) me =
174 suspectNo = friendById me Map.! rrSuspect msg 195 suspectNo = friendById me Map.! rrSuspect msg
175 adj f = f { registeredTerminal = Just $ rrSuspect msg } 196 adj f = f { registeredTerminal = Just $ rrSuspect msg }
176 197
177 terminateBackward = ( me', []) 198 terminateBackward = MessageReaction me' [] []
178 where me' = me { routeTails = 199 where me' = me { routeTails =
179 IntMap.insert (rrRoute msg) (rrTail msg) 200 IntMap.insert (rrRoute msg) (rrTail msg)
180 $ routeTails me 201 $ routeTails me
181 } 202 }
182 203
183{- 204balanceCondition :: (NodeId,NodeId) -> [Int] -> ThisNode -> (ThisNode, Bool)
184intersectionSatisfied :: SuspectCred -> ThisNode -> Bool 205balanceCondition (ka,kb) routeNums me = (me',didPass)
185intersectionSatisfied suspect me = todo
186 where 206 where
187 x = IntMap.filter isSuspectTail $ routeTails me 207 me' = me { tailCounters = counters' }
188 stails = IntMap.elems $ suspectTails suspect 208 where
189 isSuspectTail tl = tl `elem` stails 209 counters' = if didPass then incremented else tailCounters me
190-} 210 incremented = IntMap.adjust (+1) cmin $ tailCounters me
191 211
212 didPass = fromIntegral (cmin + 1) <= b
213
214 b = h * max (logBase 2 r) a :: Double
215 where
216 r = fromIntegral $ routeCount me
217 a = fromIntegral ( 1 + sum (IntMap.elems $ tailCounters me) ) / r
218 h = 4 -- h > 1 is some universal constant that is not too small (they used
219 -- h = 4 in their experiments).
220 cmin = minimumBy indexCompare routeNums
221 where
222 indexCompare ca cb = tieBreak $ comparing (tailCounters me !) ca cb
223 where
224 tieBreak EQ = compare ca cb
225 tieBreak x = x