diff --git a/Hash2Pub/src/Hash2Pub/ASN1Coding.hs b/Hash2Pub/src/Hash2Pub/ASN1Coding.hs index 2cfc48f..1812d87 100644 --- a/Hash2Pub/src/Hash2Pub/ASN1Coding.hs +++ b/Hash2Pub/src/Hash2Pub/ASN1Coding.hs @@ -18,68 +18,7 @@ import Safe import Hash2Pub.FediChord import Hash2Pub.Utils -import Hash2Pub.DHTProtocol (QueryResponse (..)) - -import Debug.Trace (trace) - -data Action = - QueryID - | Join - | Leave - | Stabilise - | Ping - deriving (Show, Eq, Enum) - --- ToDo: probably move this to DHTProtocol as it is high-level - -data FediChordMessage = - Request { - requestID :: Integer - , sender :: NodeState - , parts :: Integer - , part :: Integer - -- ^ part starts at 0 - , action :: Action - , payload :: ActionPayload - } - | Response { - responseTo :: Integer - , senderID :: NodeID - , parts :: Integer - , part :: Integer - , action :: Action - , payload :: ActionPayload - } deriving (Show, Eq) - -data ActionPayload = - QueryIDRequestPayload { - queryTargetID :: NodeID - , queryLBestNodes :: Integer - } - | JoinRequestPayload - | LeaveRequestPayload { - leaveSuccessors :: [NodeID] - , leavePredecessors :: [NodeID] - } - | StabiliseRequestPayload - | PingRequestPayload - | QueryIDResponsePayload { - queryResult :: QueryResponse - } - | JoinResponsePayload { - joinSuccessors :: [NodeID] - , joinPredecessors :: [NodeID] - , joinCache :: [CacheEntry] - } - | LeaveResponsePayload - | StabiliseResponsePayload { - stabiliseSuccessors :: [NodeID] - , stabilisePredecessors :: [NodeID] - } - | PingResponsePayload { - pingNodeStates :: [NodeState] - } - deriving (Show, Eq) +import Hash2Pub.DHTProtocol -- | Try splitting a payload into multiple parts to be able to reduce size of -- individual messages. @@ -245,8 +184,8 @@ encodeNodeState ns = [ , End Sequence ] -encodeCacheEntry :: CacheEntry -> [ASN1] -encodeCacheEntry (NodeEntry _ ns timestamp) = +encodeCacheEntry :: RemoteCacheEntry -> [ASN1] +encodeCacheEntry (RemoteCacheEntry ns timestamp) = Start Sequence : encodeNodeState ns -- ToDo: possibly optimise this by using dlists @@ -392,13 +331,13 @@ parseNodeState = onNextContainer Sequence $ do } -parseCacheEntry :: ParseASN1 CacheEntry +parseCacheEntry :: ParseASN1 RemoteCacheEntry parseCacheEntry = onNextContainer Sequence $ do node <- parseNodeState timestamp <- toEnum . fromIntegral <$> parseInteger - return $ NodeEntry False node timestamp + return $ RemoteCacheEntry node timestamp -parseNodeCache :: ParseASN1 [CacheEntry] +parseNodeCache :: ParseASN1 [RemoteCacheEntry] parseNodeCache = onNextContainer Sequence $ getMany parseCacheEntry parseJoinRequest :: ParseASN1 ActionPayload diff --git a/Hash2Pub/src/Hash2Pub/DHTProtocol.hs b/Hash2Pub/src/Hash2Pub/DHTProtocol.hs index 90c9a33..028605c 100644 --- a/Hash2Pub/src/Hash2Pub/DHTProtocol.hs +++ b/Hash2Pub/src/Hash2Pub/DHTProtocol.hs @@ -3,11 +3,20 @@ module Hash2Pub.DHTProtocol ( QueryResponse (..) , incomingQuery + , addCacheEntry + , deleteCacheEntry + , RemoteCacheEntry(..) + , toRemoteCacheEntry + , Action(..) + , ActionPayload(..) + , FediChordMessage(..) ) where import Data.Maybe (maybe, fromMaybe) import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Time.Clock.POSIX import Hash2Pub.FediChord ( NodeID @@ -20,9 +29,7 @@ import Hash2Pub.FediChord , putPredecessors , cacheGetNodeStateUnvalidated , NodeCache - , CacheEntry - , addCacheEntry - , deleteCacheEntry + , CacheEntry(..) , cacheLookup , cacheLookupSucc , cacheLookupPred @@ -31,7 +38,9 @@ import Hash2Pub.FediChord import Debug.Trace (trace) -data QueryResponse = FORWARD (Set.Set CacheEntry) -- ^return closest nodes from local cache. +-- === queries === + +data QueryResponse = FORWARD (Set.Set RemoteCacheEntry) -- ^return closest nodes from local cache. -- whole cache entry is returned for making -- the entry time stamp available to the -- protocol serialiser @@ -51,20 +60,120 @@ incomingQuery ownState nCache lBestNodes targetID preds = fromMaybe [] $ getPredecessors ownState ownID = nid ownState - closestSuccessor :: Set.Set CacheEntry - closestSuccessor = maybe Set.empty Set.singleton $ cacheLookupSucc targetID nCache + closestSuccessor :: Set.Set RemoteCacheEntry + closestSuccessor = maybe Set.empty Set.singleton $ toRemoteCacheEntry =<< cacheLookupSucc targetID nCache - closestPredecessors :: Set.Set CacheEntry + closestPredecessors :: Set.Set RemoteCacheEntry closestPredecessors = closestPredecessor (lBestNodes-1) $ nid ownState - closestPredecessor :: (Integral n, Show n) => n -> NodeID -> Set.Set CacheEntry + closestPredecessor :: (Integral n, Show n) => n -> NodeID -> Set.Set RemoteCacheEntry closestPredecessor 0 _ = Set.empty closestPredecessor remainingLookups lastID | remainingLookups < 0 = Set.empty | otherwise = let result = cacheLookupPred lastID nCache in - case result of + case toRemoteCacheEntry =<< result of Nothing -> Set.empty - Just nPred -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid . cacheGetNodeStateUnvalidated $ nPred) + Just nPred@(RemoteCacheEntry ns ts) -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid ns) + +-- === protocol serialisation data types + +data Action = + QueryID + | Join + | Leave + | Stabilise + | Ping + deriving (Show, Eq, Enum) + +data FediChordMessage = + Request { + requestID :: Integer + , sender :: NodeState + , parts :: Integer + , part :: Integer + -- ^ part starts at 0 + , action :: Action + , payload :: ActionPayload + } + | Response { + responseTo :: Integer + , senderID :: NodeID + , parts :: Integer + , part :: Integer + , action :: Action + , payload :: ActionPayload + } deriving (Show, Eq) + +data ActionPayload = + QueryIDRequestPayload { + queryTargetID :: NodeID + , queryLBestNodes :: Integer + } + | JoinRequestPayload + | LeaveRequestPayload { + leaveSuccessors :: [NodeID] + , leavePredecessors :: [NodeID] + } + | StabiliseRequestPayload + | PingRequestPayload + | QueryIDResponsePayload { + queryResult :: QueryResponse + } + | JoinResponsePayload { + joinSuccessors :: [NodeID] + , joinPredecessors :: [NodeID] + , joinCache :: [RemoteCacheEntry] + } + | LeaveResponsePayload + | StabiliseResponsePayload { + stabiliseSuccessors :: [NodeID] + , stabilisePredecessors :: [NodeID] + } + | PingResponsePayload { + pingNodeStates :: [NodeState] + } + deriving (Show, Eq) + +-- | dedicated data type for cache entries sent to or received from the network, +-- as these have to be considered as unvalidated. Also helps with separation of trust. +data RemoteCacheEntry = RemoteCacheEntry NodeState POSIXTime + deriving (Show, Eq) + +instance Ord RemoteCacheEntry where + (RemoteCacheEntry ns1 _) `compare` (RemoteCacheEntry ns2 _) = nid ns1 `compare` nid ns2 + +toRemoteCacheEntry :: CacheEntry -> Maybe RemoteCacheEntry +toRemoteCacheEntry (NodeEntry _ ns ts) = Just $ RemoteCacheEntry ns ts +toRemoteCacheEntry (ProxyEntry _ (Just entry@NodeEntry{})) = toRemoteCacheEntry entry +toRemoteCacheEntry _ = Nothing + +-- cache operations + +-- | update or insert a 'RemoteCacheEntry' into the cache, +-- converting it to a local 'CacheEntry' +addCacheEntry :: RemoteCacheEntry -- ^ a remote cache entry received from network + -> NodeCache -- ^ node cache to insert to + -> IO NodeCache -- ^ new node cache with the element inserted +addCacheEntry (RemoteCacheEntry ns ts) cache = do + now <- getPOSIXTime + let + -- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity + timestamp' = if ts <= now then ts else now + newCache = Map.insertWith insertCombineFunction (nid ns) (NodeEntry False ns timestamp') cache + insertCombineFunction newVal@(NodeEntry newValidationState newNode newTimestamp) oldVal = + case oldVal of + ProxyEntry n _ -> ProxyEntry n (Just newVal) + NodeEntry oldValidationState _ oldTimestamp -> NodeEntry oldValidationState newNode (max oldTimestamp newTimestamp) + return newCache + +-- | delete the node with given ID from cache +deleteCacheEntry :: NodeID -- ^ID of the node to be deleted + -> NodeCache -- ^cache to delete from + -> NodeCache -- ^cache without the specified element +deleteCacheEntry = Map.update modifier + where + modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) + modifier NodeEntry {} = Nothing diff --git a/Hash2Pub/src/Hash2Pub/FediChord.hs b/Hash2Pub/src/Hash2Pub/FediChord.hs index 19d8046..e0ba99a 100644 --- a/Hash2Pub/src/Hash2Pub/FediChord.hs +++ b/Hash2Pub/src/Hash2Pub/FediChord.hs @@ -25,8 +25,6 @@ module Hash2Pub.FediChord ( , CacheEntry(..) , cacheGetNodeStateUnvalidated , initCache - , addCacheEntry - , deleteCacheEntry , cacheLookup , cacheLookupSucc , cacheLookupPred @@ -234,32 +232,6 @@ initCache = Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (mi where proxyEntry (from,to) = (from, ProxyEntry to Nothing) --- | insert or update a new @NodeState@ node into the cache -addCacheEntry :: NodeState -- ^ the node to insert - -> Integer -- ^ initial age penalty in seconds - -> NodeCache -- ^ node cache to insert to - -> IO NodeCache -- ^ new node cache with the element inserted -addCacheEntry node timestamp cache = do - now <- getPOSIXTime - let - -- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity - timestamp' = fromInteger timestamp - newCache = Map.insertWith insertCombineFunction (nid node) (NodeEntry False node timestamp') cache - insertCombineFunction newVal@(NodeEntry newValidationState newNode newTimestamp) oldVal = - case oldVal of - ProxyEntry n _ -> ProxyEntry n (Just newVal) - NodeEntry oldValidationState _ oldTimestamp -> NodeEntry oldValidationState newNode (max oldTimestamp newTimestamp) - return newCache - --- | delete the node with given ID from cache -deleteCacheEntry :: NodeID -- ^ID of the node to be deleted - -> NodeCache -- ^cache to delete from - -> NodeCache -- ^cache without the specified element -deleteCacheEntry = Map.update modifier - where - modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing) - modifier NodeEntry {} = Nothing - -- | Maybe returns the cache entry stored at given key cacheLookup :: NodeID -- ^lookup key -> NodeCache -- ^lookup cache