schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

run stylish

Browse source
This commit is contained in:
Trolli Schmittlauch 2020-05-19 17:55:40 +02:00
parent 8d18f952cd
commit c31baa3635
4 changed files with 124 additions and 143 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/Hash2Pub/ASN1Coding.hs
View file

@ -3,7 +3,7 @@
module Hash2Pub.ASN1Coding where module Hash2Pub.ASN1Coding where
import Control.Exception (displayException) import Control.Exception (displayException)
import Data.ASN1.BinaryEncoding -- asn1-encoding package import Data.ASN1.BinaryEncoding
import Data.ASN1.Encoding import Data.ASN1.Encoding
import Data.ASN1.Error () import Data.ASN1.Error ()
import Data.ASN1.Parse import Data.ASN1.Parse
@ -17,8 +17,8 @@ import Data.Time.Clock.POSIX ()
import Safe import Safe
import Hash2Pub.FediChord import Hash2Pub.FediChord
import Hash2Pub.Utils
import Hash2Pub.ProtocolTypes import Hash2Pub.ProtocolTypes
import Hash2Pub.Utils
import Debug.Trace import Debug.Trace

34
src/Hash2Pub/DHTProtocol.hs
View file

@ -15,29 +15,31 @@ module Hash2Pub.DHTProtocol
) )
where where
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent.STM.TQueue import Control.Concurrent.STM.TBQueue
import Control.Concurrent.STM.TBQueue import Control.Concurrent.STM.TQueue
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (fromMaybe, maybe) import Data.Maybe (fromMaybe, maybe)
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Network.Socket hiding (recv, recvFrom, send, sendTo) import Network.Socket hiding (recv, recvFrom, send,
sendTo)
import Network.Socket.ByteString import Network.Socket.ByteString
import System.Timeout import System.Timeout
import Hash2Pub.ASN1Coding import Hash2Pub.ASN1Coding
import Hash2Pub.FediChord (CacheEntry (..), NodeCache, NodeID, import Hash2Pub.FediChord (CacheEntry (..), NodeCache,
NodeState (..), NodeID, NodeState (..),
cacheGetNodeStateUnvalidated, cacheGetNodeStateUnvalidated,
cacheLookup, cacheLookupPred, cacheLookup, cacheLookupPred,
cacheLookupSucc, getPredecessors, cacheLookupSucc,
getSuccessors, localCompare, getPredecessors, getSuccessors,
putPredecessors, putSuccessors) localCompare, putPredecessors,
putSuccessors)
import Hash2Pub.ProtocolTypes import Hash2Pub.ProtocolTypes
import Debug.Trace (trace) import Debug.Trace (trace)
-- === queries === -- === queries ===

108
src/Hash2Pub/FediChord.hs
View file

@ -122,58 +122,43 @@ a `localCompare` b
-- | represents a node and all its important state -- | represents a node and all its important state
data NodeState = NodeState { data NodeState = NodeState
nid :: NodeID { nid :: NodeID
, domain :: String , domain :: String
-- ^ full public domain name the node is reachable under -- ^ full public domain name the node is reachable under
, ipAddr :: HostAddress6 , ipAddr :: HostAddress6
-- the node's public IPv6 address -- the node's public IPv6 address
, dhtPort :: PortNumber , dhtPort :: PortNumber
-- ^ port of the DHT itself -- ^ port of the DHT itself
, apPort :: Maybe PortNumber , apPort :: Maybe PortNumber
-- ^ port of the ActivityPub relay and storage service -- ^ port of the ActivityPub relay and storage service
-- might have to be queried first , vServerID :: Integer
, vServerID :: Integer -- ^ ID of this vserver
-- ^ ID of this vserver , internals :: Maybe InternalNodeState
-- ^ data not present in the representation of remote nodes
-- ==== internal state ==== }
, internals :: Maybe InternalNodeState deriving (Show, Eq)
-- ^ data not present in the representation of remote nodes
-- is put into its own type.
-- This is usually @Nothing@ for all remote nodes.
} deriving (Show, Eq)
-- | encapsulates all data and parameters that are not present for remote nodes -- | encapsulates all data and parameters that are not present for remote nodes
data InternalNodeState = InternalNodeState { data InternalNodeState = InternalNodeState
nodeCache :: IORef NodeCache { nodeCache :: IORef NodeCache
-- ^ EpiChord node cache with expiry times for nodes -- ^ EpiChord node cache with expiry times for nodes
-- as the map is ordered, lookups for the closes preceding node can be done using @lookupLT@. , cacheWriteQueue :: TQueue (NodeCache -> NodeCache)
-- encapsulated into an IORef for allowing concurrent reads without locking -- ^ cache updates are not written directly to the 'nodeCache' but queued and
, cacheWriteQueue :: TQueue (NodeCache -> NodeCache) , successors :: [NodeID] -- could be a set instead as these are ordered as well
-- ^ cache updates are not written directly to the 'nodeCache' but queued and -- ^ successor nodes in ascending order by distance
-- only processed by a single writer thread to prevent lost updates. , predecessors :: [NodeID]
-- All nodeCache modifying functions have to be partially applied enough before -- ^ predecessor nodes in ascending order by distance
-- being put into the queue. , kNeighbours :: Int
-- -- ^ desired length of predecessor and successor list
, successors :: [NodeID] -- could be a set instead as these are ordered as well , lNumBestNodes :: Int
-- ^ successor nodes in ascending order by distance -- ^ number of best next hops to provide
, predecessors :: [NodeID] , pNumParallelQueries :: Int
-- ^ predecessor nodes in ascending order by distance -- ^ number of parallel sent queries
----- protocol parameters ----- , jEntriesPerSlice :: Int
-- TODO: evaluate moving these somewhere else -- ^ number of desired entries per cache slice
, kNeighbours :: Int }
-- ^ desired length of predecessor and successor list deriving (Show, Eq)
-- needs to be parameterisable for simulation purposes
, lNumBestNodes :: Int
-- ^ number of best next hops to provide
-- needs to be parameterisable for simulation purposes
, pNumParallelQueries :: Int
-- ^ number of parallel sent queries
-- needs to be parameterisable for simulation purposes
, jEntriesPerSlice :: Int
-- ^ number of desired entries per cache slice
-- needs to be parameterisable for simulation purposes
} deriving (Show, Eq)
-- | defining Show instances to be able to print NodeState for debug purposes -- | defining Show instances to be able to print NodeState for debug purposes
instance Typeable a => Show (IORef a) where instance Typeable a => Show (IORef a) where
@ -230,12 +215,8 @@ getLNumBestNodes = getInternals_ lNumBestNodes
type NodeCache = Map.Map NodeID CacheEntry type NodeCache = Map.Map NodeID CacheEntry
-- |an entry of the 'nodeCache' can hold 2 different kinds of data -- |an entry of the 'nodeCache' can hold 2 different kinds of data
data CacheEntry = data CacheEntry = NodeEntry Bool NodeState POSIXTime
-- | an entry representing its validation status, the node state and its timestamp | ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry)
NodeEntry Bool NodeState POSIXTime
-- | a proxy field for closing the ring structure, indicating the lookup shall be
-- resumed at the given @NodeID@ unless the @ProxyEntry@ itself holds a @NodeEntry@
| ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry)
deriving (Show, Eq) deriving (Show, Eq)
-- | as a compromise, only NodeEntry components are ordered by their NodeID -- | as a compromise, only NodeEntry components are ordered by their NodeID
@ -247,7 +228,9 @@ instance Ord CacheEntry where
extractID (NodeEntry _ eState _) = nid eState extractID (NodeEntry _ eState _) = nid eState
extractID (ProxyEntry _ _) = error "proxy entries should never appear outside of the NodeCache" extractID (ProxyEntry _ _) = error "proxy entries should never appear outside of the NodeCache"
data ProxyDirection = Backwards | Forwards deriving (Show, Eq) data ProxyDirection = Backwards
| Forwards
deriving (Show, Eq)
instance Enum ProxyDirection where instance Enum ProxyDirection where
toEnum (-1) = Backwards toEnum (-1) = Backwards
@ -430,11 +413,12 @@ byteStringToUInteger bs = sum $ parsedBytes 0 bs
-- persist them on disk so they can be used for all following bootstraps -- persist them on disk so they can be used for all following bootstraps
-- | configuration values used for initialising the FediChord DHT -- | configuration values used for initialising the FediChord DHT
data FediChordConf = FediChordConf { data FediChordConf = FediChordConf
confDomain :: String { confDomain :: String
, confIP :: HostAddress6 , confIP :: HostAddress6
, confDhtPort :: Int , confDhtPort :: Int
} deriving (Show, Eq) }
deriving (Show, Eq)
-- | initialise data structures, compute own IDs and bind to listening socket -- | initialise data structures, compute own IDs and bind to listening socket
-- ToDo: load persisted state, thus this function already operates in IO -- ToDo: load persisted state, thus this function already operates in IO

119
src/Hash2Pub/ProtocolTypes.hs
View file

@ -1,74 +1,69 @@
module Hash2Pub.ProtocolTypes where module Hash2Pub.ProtocolTypes where
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Time.Clock.POSIX (POSIXTime) import Data.Time.Clock.POSIX (POSIXTime)
import Hash2Pub.FediChord import Hash2Pub.FediChord
data QueryResponse = FORWARD (Set.Set RemoteCacheEntry) -- ^return closest nodes from local cache. data QueryResponse = FORWARD (Set.Set RemoteCacheEntry)
-- whole cache entry is returned for making | FOUND NodeState
-- the entry time stamp available to the deriving (Show, Eq)
-- protocol serialiser
| FOUND NodeState -- ^node is the responsible node for queried ID
deriving (Show, Eq)
-- === protocol serialisation data types -- === protocol serialisation data types
data Action = data Action = QueryID
QueryID | Join
| Join | Leave
| Leave | Stabilise
| Stabilise | Ping
| Ping deriving (Show, Eq, Enum)
deriving (Show, Eq, Enum)
data FediChordMessage = data FediChordMessage = Request
Request { { requestID :: Integer
requestID :: Integer , sender :: NodeState
, sender :: NodeState , parts :: Integer
, parts :: Integer , part :: Integer
, part :: Integer -- ^ part starts at 0
-- ^ part starts at 0 , action :: Action
, action :: Action , payload :: Maybe ActionPayload
, payload :: Maybe ActionPayload }
} | Response
| Response { { responseTo :: Integer
responseTo :: Integer , senderID :: NodeID
, senderID :: NodeID , parts :: Integer
, parts :: Integer , part :: Integer
, part :: Integer , action :: Action
, action :: Action , payload :: Maybe ActionPayload
, payload :: Maybe ActionPayload }
} deriving (Show, Eq) deriving (Show, Eq)
data ActionPayload = data ActionPayload = QueryIDRequestPayload
QueryIDRequestPayload { { queryTargetID :: NodeID
queryTargetID :: NodeID , queryLBestNodes :: Integer
, queryLBestNodes :: Integer }
} | JoinRequestPayload
| JoinRequestPayload | LeaveRequestPayload
| LeaveRequestPayload { { leaveSuccessors :: [NodeID]
leaveSuccessors :: [NodeID] , leavePredecessors :: [NodeID]
, leavePredecessors :: [NodeID] }
} | StabiliseRequestPayload
| StabiliseRequestPayload | PingRequestPayload
| PingRequestPayload | QueryIDResponsePayload
| QueryIDResponsePayload { { queryResult :: QueryResponse
queryResult :: QueryResponse }
} | JoinResponsePayload
| JoinResponsePayload { { joinSuccessors :: [NodeID]
joinSuccessors :: [NodeID] , joinPredecessors :: [NodeID]
, joinPredecessors :: [NodeID] , joinCache :: [RemoteCacheEntry]
, joinCache :: [RemoteCacheEntry] }
} | LeaveResponsePayload
| LeaveResponsePayload | StabiliseResponsePayload
| StabiliseResponsePayload { { stabiliseSuccessors :: [NodeID]
stabiliseSuccessors :: [NodeID] , stabilisePredecessors :: [NodeID]
, stabilisePredecessors :: [NodeID] }
} | PingResponsePayload
| PingResponsePayload { { pingNodeStates :: [NodeState]
pingNodeStates :: [NodeState] }
}
deriving (Show, Eq) deriving (Show, Eq)
-- | global limit of parts per message used when (de)serialising messages. -- | global limit of parts per message used when (de)serialising messages.