summaryrefslogtreecommitdiff
path: root/SybilLimit.hs
diff options
context:
space:
mode:
Diffstat (limited to 'SybilLimit.hs')
-rw-r--r--SybilLimit.hs61
1 files changed, 58 insertions, 3 deletions
diff --git a/SybilLimit.hs b/SybilLimit.hs
index 8324b85..bb0a54f 100644
--- a/SybilLimit.hs
+++ b/SybilLimit.hs
@@ -1,16 +1,17 @@
1{-# LANGUAGE StandaloneDeriving #-} 1{-# LANGUAGE StandaloneDeriving #-}
2module SybilLimit where 2module SybilLimit where
3 3
4import Data.List 4import Data.List ( foldl' )
5import Data.IntMap.Strict ( IntMap, (!) ) 5import Data.IntMap.Strict ( IntMap, (!) )
6import qualified Data.IntMap.Strict as IntMap 6import qualified Data.IntMap.Strict as IntMap
7import Data.Traversable 7import Data.Traversable ( sequenceA )
8import Control.Applicative 8import Control.Applicative
9-- import System.Random 9-- import System.Random
10import Stochastic
11import Data.Map.Strict ( Map ) 10import Data.Map.Strict ( Map )
12import qualified Data.Map as Map 11import qualified Data.Map as Map
13 12
13import Stochastic
14
14data NodeId 15data NodeId
15 16
16deriving instance Ord NodeId 17deriving instance Ord NodeId
@@ -22,7 +23,11 @@ data ThisNode = ThisNode
22 , friendById :: Map NodeId Int 23 , friendById :: Map NodeId Int
23 , routeTails :: IntMap (NodeId,NodeId) 24 , routeTails :: IntMap (NodeId,NodeId)
24 -- ^ Terminal edge by instance number. 25 -- ^ Terminal edge by instance number.
26 , tailCounters :: IntMap Int
27 -- ^ verificaiton counter by instance number.
25 , routeCount :: Int 28 , routeCount :: Int
29 -- ^ The r parameter of SybilLimit.
30 , pendingVerifications :: Map NodeId PendingIntersection
26 } 31 }
27 32
28data FriendNode = FriendNode 33data FriendNode = FriendNode
@@ -37,6 +42,14 @@ data FriendNode = FriendNode
37 } 42 }
38 43
39 44
45-- | When 'iPendingTails' is empty, the intersection condition is passed if and
46-- only if 'iVerifiedTails' is not empty.
47data PendingIntersection = PendingIntersection
48 { iSuspect :: NodeId
49 , iPendingTails :: Map (NodeId,NodeId) ()
50 , iVerifiedTails :: Map (NodeId,NodeId) ()
51 }
52
40data PeerMessage 53data PeerMessage
41 = ForwardRRMessage { rrRoute :: Int 54 = ForwardRRMessage { rrRoute :: Int
42 , rrCount :: Int 55 , rrCount :: Int
@@ -44,8 +57,19 @@ data PeerMessage
44 | BackwardRRMessage { rrRoute :: Int 57 | BackwardRRMessage { rrRoute :: Int
45 , rrCount :: Int 58 , rrCount :: Int
46 , rrTail :: (NodeId,NodeId) } 59 , rrTail :: (NodeId,NodeId) }
60 | RegistrationQuery { rrSuspect :: NodeId
61 , rrRegisteredFrom :: NodeId }
62 | RegistrationResponse { rrSuspect :: NodeId
63 , rrRegisteredFrom :: NodeId
64 , rrValidRegistration :: Bool }
65
66{-
67 | CredMessage SuspectCred
47 68
69data SuspectCred = SuspectCred { suspectId :: NodeId
70 , suspectTails :: IntMap (NodeId,NodeId) }
48 71
72-}
49 73
50friendNode :: NodeId -> FriendNode 74friendNode :: NodeId -> FriendNode
51friendNode nid = FriendNode nid IntMap.empty IntMap.empty Nothing 75friendNode nid = FriendNode nid IntMap.empty IntMap.empty Nothing
@@ -105,6 +129,7 @@ updateRoute i (k,j) fs = jfromk $ ktoj fs
105 setFrom i x f = f { routesFrom = IntMap.insert i x (routesFrom f)} 129 setFrom i x f = f { routesFrom = IntMap.insert i x (routesFrom f)}
106 130
107 131
132forwardMessage :: ThisNode -> (FriendNode -> IntMap Int) -> (NodeId,PeerMessage) -> (NodeId, PeerMessage)
108forwardMessage me next (srcId,msg) = msg' 133forwardMessage me next (srcId,msg) = msg'
109 where msg' = ( dest, msg { rrCount = rrCount msg + 1 } ) 134 where msg' = ( dest, msg { rrCount = rrCount msg + 1 } )
110 srcno = friendById me Map.! srcId 135 srcno = friendById me Map.! srcId
@@ -112,6 +137,27 @@ forwardMessage me next (srcId,msg) = msg'
112 dest = friendId (friends me ! destno) 137 dest = friendId (friends me ! destno)
113 138
114reactToMessage :: Int -> (NodeId,PeerMessage) -> ThisNode -> (ThisNode, [(NodeId,PeerMessage)]) 139reactToMessage :: Int -> (NodeId,PeerMessage) -> ThisNode -> (ThisNode, [(NodeId,PeerMessage)])
140reactToMessage w (srcId, msg@(RegistrationResponse {})) me = (me', [])
141 where
142 me' = me { pendingVerifications = vs' }
143 vs' :: Map NodeId PendingIntersection
144 vs' = Map.adjust adj (rrSuspect msg) $ pendingVerifications me
145 adj p = p { iPendingTails = Map.delete (rrRegisteredFrom msg, srcId)
146 $ iPendingTails p
147 , iVerifiedTails =
148 if rrValidRegistration msg then v' else iVerifiedTails p
149 }
150 where v' = Map.insert (rrRegisteredFrom msg, srcId) ()
151 $ iVerifiedTails p
152
153reactToMessage w (srcId, msg@(RegistrationQuery {})) me = (me, [(srcId,resp)])
154 where
155 resp = RegistrationResponse { rrSuspect = rrSuspect msg
156 , rrRegisteredFrom = rrRegisteredFrom msg
157 , rrValidRegistration = check }
158 key = friendById me Map.! rrRegisteredFrom msg
159 check = registeredTerminal (friends me ! key) == Just (rrSuspect msg)
160
115reactToMessage w (srcId, msg) me = 161reactToMessage w (srcId, msg) me =
116 if rrCount msg == w then terminate else (me, [forwardMessage me next (srcId,msg)]) 162 if rrCount msg == w then terminate else (me, [forwardMessage me next (srcId,msg)])
117 where 163 where
@@ -134,3 +180,12 @@ reactToMessage w (srcId, msg) me =
134 $ routeTails me 180 $ routeTails me
135 } 181 }
136 182
183{-
184intersectionSatisfied :: SuspectCred -> ThisNode -> Bool
185intersectionSatisfied suspect me = todo
186 where
187 x = IntMap.filter isSuspectTail $ routeTails me
188 stails = IntMap.elems $ suspectTails suspect
189 isSuspectTail tl = tl `elem` stails
190-}
191