From 8c9fc39fc4e40846db843fb6e49b1897c6c0e7ba Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 10 Aug 2014 18:15:23 -0400 Subject: balance condition implemented in SybilLimit --- SybilLimit.hs | 92 ++++++++++++++++++++++++++++++++++++++++------------------- 1 file 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 @@ {-# LANGUAGE StandaloneDeriving #-} module SybilLimit where -import Data.List ( foldl' ) +import Data.List ( foldl', minimumBy ) +import Data.Maybe ( fromMaybe ) +import Data.Ord ( comparing ) import Data.IntMap.Strict ( IntMap, (!) ) import qualified Data.IntMap.Strict as IntMap import Data.Traversable ( sequenceA ) @@ -45,9 +47,9 @@ data FriendNode = FriendNode -- | When 'iPendingTails' is empty, the intersection condition is passed if and -- only if 'iVerifiedTails' is not empty. data PendingIntersection = PendingIntersection - { iSuspect :: NodeId - , iPendingTails :: Map (NodeId,NodeId) () - , iVerifiedTails :: Map (NodeId,NodeId) () + { iSuspect :: NodeId -- todo: neccessary? + , iPendingTails :: Map (NodeId,NodeId) [Int] + , iVerifiedTails :: Map (NodeId,NodeId) [Int] } data PeerMessage @@ -63,13 +65,16 @@ data PeerMessage , rrRegisteredFrom :: NodeId , rrValidRegistration :: Bool } -{- - | CredMessage SuspectCred -data SuspectCred = SuspectCred { suspectId :: NodeId - , suspectTails :: IntMap (NodeId,NodeId) } +data SybilCheck + = SybilCheck { chkSuspect :: NodeId + , chkAccepted :: Bool } --} +data MessageReaction = MessageReaction + { changedState :: ThisNode + , outgoingMessages :: [(NodeId, PeerMessage)] + , sybilChecks :: [SybilCheck] + } friendNode :: NodeId -> FriendNode friendNode nid = FriendNode nid IntMap.empty IntMap.empty Nothing @@ -136,21 +141,34 @@ forwardMessage me next (srcId,msg) = msg' destno = next (friends me ! srcno) ! rrRoute msg dest = friendId (friends me ! destno) -reactToMessage :: Int -> (NodeId,PeerMessage) -> ThisNode -> (ThisNode, [(NodeId,PeerMessage)]) -reactToMessage w (srcId, msg@(RegistrationResponse {})) me = (me', []) +reactToMessage :: Int -> (NodeId,PeerMessage) -> ThisNode -> MessageReaction +reactToMessage w (srcId, msg@(RegistrationResponse {})) me = + MessageReaction me' [] sybils where - me' = me { pendingVerifications = vs' } + me0 = me { pendingVerifications = vs' } vs' :: Map NodeId PendingIntersection vs' = Map.adjust adj (rrSuspect msg) $ pendingVerifications me - adj p = p { iPendingTails = Map.delete (rrRegisteredFrom msg, srcId) - $ iPendingTails p + tail = (rrRegisteredFrom msg, srcId) + adj p = p { iPendingTails = Map.delete tail $ iPendingTails p , iVerifiedTails = - if rrValidRegistration msg then v' else iVerifiedTails p + if rrValidRegistration msg then goodTail else iVerifiedTails p } - where v' = Map.insert (rrRegisteredFrom msg, srcId) () - $ iVerifiedTails p - -reactToMessage w (srcId, msg@(RegistrationQuery {})) me = (me, [(srcId,resp)]) + where goodTail = Map.insert tail indexes + $ iVerifiedTails p + indexes = fromMaybe [] $ Map.lookup tail $ iPendingTails p + icheck = pendingVerifications me0 Map.! rrSuspect msg + (me',sybils) = if Map.null (iPendingTails icheck) then bcheck else (me0, []) + where bcheck = if Map.null (iVerifiedTails icheck) + then (me0, dishonest) + else balanceCheck + dishonest = [SybilCheck (rrSuspect msg) False] + indexes = fromMaybe [] $ Map.lookup tail $ iVerifiedTails icheck + balanceCheck = second chk $ balanceCondition tail indexes me0 + where chk = (:[]) . SybilCheck (rrSuspect msg) + second f (x,y) = (x,f y) + +reactToMessage w (srcId, msg@(RegistrationQuery {})) me = + MessageReaction me [(srcId,resp)] [] where resp = RegistrationResponse { rrSuspect = rrSuspect msg , rrRegisteredFrom = rrRegisteredFrom msg @@ -159,13 +177,16 @@ reactToMessage w (srcId, msg@(RegistrationQuery {})) me = (me, [(srcId,resp)]) check = registeredTerminal (friends me ! key) == Just (rrSuspect msg) reactToMessage w (srcId, msg) me = - if rrCount msg == w then terminate else (me, [forwardMessage me next (srcId,msg)]) + if rrCount msg == w then terminate + else MessageReaction me [forwardMessage me next (srcId,msg)] [] where (terminate,next) = case msg of ForwardRRMessage {} -> ( terminateForward, routesTo ) BackwardRRMessage {} -> ( terminateBackward, routesFrom ) - terminateForward = ( me { friends = friends' }, [pong] ) + terminateForward = MessageReaction me { friends = friends' } + [pong] + [] where pong =( srcId, BackwardRRMessage { rrCount = 1 , rrRoute = rrRoute msg , rrTail = (srcId, selfId me) @@ -174,18 +195,31 @@ reactToMessage w (srcId, msg) me = suspectNo = friendById me Map.! rrSuspect msg adj f = f { registeredTerminal = Just $ rrSuspect msg } - terminateBackward = ( me', []) + terminateBackward = MessageReaction me' [] [] where me' = me { routeTails = IntMap.insert (rrRoute msg) (rrTail msg) $ routeTails me } -{- -intersectionSatisfied :: SuspectCred -> ThisNode -> Bool -intersectionSatisfied suspect me = todo +balanceCondition :: (NodeId,NodeId) -> [Int] -> ThisNode -> (ThisNode, Bool) +balanceCondition (ka,kb) routeNums me = (me',didPass) where - x = IntMap.filter isSuspectTail $ routeTails me - stails = IntMap.elems $ suspectTails suspect - isSuspectTail tl = tl `elem` stails --} + me' = me { tailCounters = counters' } + where + counters' = if didPass then incremented else tailCounters me + incremented = IntMap.adjust (+1) cmin $ tailCounters me + didPass = fromIntegral (cmin + 1) <= b + + b = h * max (logBase 2 r) a :: Double + where + r = fromIntegral $ routeCount me + a = fromIntegral ( 1 + sum (IntMap.elems $ tailCounters me) ) / r + h = 4 -- h > 1 is some universal constant that is not too small (they used + -- h = 4 in their experiments). + cmin = minimumBy indexCompare routeNums + where + indexCompare ca cb = tieBreak $ comparing (tailCounters me !) ca cb + where + tieBreak EQ = compare ca cb + tieBreak x = x -- cgit v1.2.3