Registration(Query/Response) messages in SybilLimit

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 @@
 {-# LANGUAGE StandaloneDeriving #-}
 module SybilLimit where
 
-import Data.List
+import Data.List ( foldl' )
 import Data.IntMap.Strict ( IntMap, (!) )
 import qualified Data.IntMap.Strict as IntMap
-import Data.Traversable
+import Data.Traversable ( sequenceA )
 import Control.Applicative
 -- import System.Random
-import Stochastic
 import Data.Map.Strict ( Map )
 import qualified Data.Map as Map
 
+import Stochastic
+
 data NodeId
 
 deriving instance Ord NodeId
@@ -22,7 +23,11 @@ data ThisNode = ThisNode
     , friendById :: Map NodeId Int
     , routeTails :: IntMap (NodeId,NodeId)
     -- ^ Terminal edge by instance number.
+    , tailCounters :: IntMap Int
+    -- ^ verificaiton counter by instance number.
     , routeCount :: Int
+    -- ^ The r parameter of SybilLimit.
+    , pendingVerifications :: Map NodeId PendingIntersection
     }
 
 data FriendNode = FriendNode
@@ -37,6 +42,14 @@ 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) ()
+    }
+
 data PeerMessage
     = ForwardRRMessage { rrRoute :: Int
                        , rrCount :: Int
@@ -44,8 +57,19 @@ data PeerMessage
     | BackwardRRMessage { rrRoute :: Int
                         , rrCount :: Int
                         , rrTail :: (NodeId,NodeId) }
+    | RegistrationQuery { rrSuspect :: NodeId
+                        , rrRegisteredFrom :: NodeId }
+    | RegistrationResponse { rrSuspect :: NodeId
+                           , rrRegisteredFrom :: NodeId
+                           , rrValidRegistration :: Bool }
+
+{-
+    | CredMessage SuspectCred
 
+data SuspectCred = SuspectCred { suspectId :: NodeId
+                               , suspectTails :: IntMap (NodeId,NodeId) }
 
+-}
 
 friendNode :: NodeId -> FriendNode
 friendNode nid = FriendNode nid IntMap.empty IntMap.empty Nothing
@@ -105,6 +129,7 @@ updateRoute i (k,j) fs = jfromk $ ktoj fs
     setFrom i x f = f { routesFrom = IntMap.insert i x (routesFrom f)}
 
 
+forwardMessage :: ThisNode -> (FriendNode -> IntMap Int) -> (NodeId,PeerMessage) -> (NodeId, PeerMessage)
 forwardMessage me next (srcId,msg) = msg'
       where msg' = ( dest, msg { rrCount = rrCount msg + 1 } )
             srcno = friendById me Map.! srcId
@@ -112,6 +137,27 @@ forwardMessage me next (srcId,msg) = msg'
             dest = friendId (friends me ! destno)
 
 reactToMessage :: Int -> (NodeId,PeerMessage) -> ThisNode -> (ThisNode, [(NodeId,PeerMessage)])
+reactToMessage w (srcId, msg@(RegistrationResponse {})) me = (me', [])
+ where
+    me' = 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
+              , iVerifiedTails =
+                    if rrValidRegistration msg then v' else iVerifiedTails p
+              }
+        where v' = Map.insert (rrRegisteredFrom msg, srcId) ()
+                            $ iVerifiedTails p
+
+reactToMessage w (srcId, msg@(RegistrationQuery {})) me = (me, [(srcId,resp)])
+ where
+    resp = RegistrationResponse { rrSuspect = rrSuspect msg
+                                , rrRegisteredFrom = rrRegisteredFrom msg
+                                , rrValidRegistration = check }
+    key = friendById me Map.! rrRegisteredFrom msg
+    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)])
  where
@@ -134,3 +180,12 @@ reactToMessage w (srcId, msg) me =
                                      $ routeTails me
                      }
 
+{-
+intersectionSatisfied :: SuspectCred -> ThisNode -> Bool
+intersectionSatisfied suspect me = todo
+ where
+    x = IntMap.filter isSuspectTail $ routeTails me
+    stails = IntMap.elems $ suspectTails suspect
+    isSuspectTail tl = tl `elem` stails
+-}
+