113 lines
3.5 KiB
Haskell
113 lines
3.5 KiB
Haskell
module Hash2Pub.ProtocolTypes where
|
|
|
|
import qualified Data.Set as Set
|
|
import Data.Time.Clock.POSIX (POSIXTime)
|
|
|
|
import Hash2Pub.FediChordTypes
|
|
|
|
data QueryResponse = FORWARD (Set.Set RemoteCacheEntry)
|
|
| FOUND RemoteNodeState
|
|
deriving (Show, Eq)
|
|
|
|
-- === protocol serialisation data types
|
|
|
|
data Action = QueryID
|
|
| Join
|
|
| Leave
|
|
| Stabilise
|
|
| Ping
|
|
| QueryLoad
|
|
deriving (Show, Eq, Enum)
|
|
|
|
data FediChordMessage = Request
|
|
{ requestID :: Integer
|
|
, receiverID :: NodeID
|
|
, sender :: RemoteNodeState
|
|
, part :: Integer
|
|
, isFinalPart :: Bool
|
|
-- ^ part starts at 1
|
|
, action :: Action
|
|
, payload :: Maybe ActionPayload
|
|
}
|
|
| Response
|
|
{ requestID :: Integer
|
|
, senderID :: NodeID
|
|
, part :: Integer
|
|
, isFinalPart :: Bool
|
|
, action :: Action
|
|
, payload :: Maybe ActionPayload
|
|
}
|
|
deriving (Show, Eq)
|
|
|
|
instance Ord FediChordMessage where
|
|
compare a@Request{} b@Request{} | requestID a == requestID b = part a `compare` part b
|
|
| otherwise = requestID a `compare` requestID b
|
|
compare a@Response{} b@Response{} | requestID a == requestID b = part a `compare` part b
|
|
| otherwise = requestID a `compare` requestID b
|
|
-- comparing different constructor types always yields "not equal"
|
|
compare _ _ = LT
|
|
|
|
data ActionPayload = QueryIDRequestPayload
|
|
{ queryTargetID :: NodeID
|
|
, queryLBestNodes :: Integer
|
|
}
|
|
| JoinRequestPayload
|
|
| LeaveRequestPayload
|
|
{ leaveSuccessors :: [RemoteNodeState]
|
|
, leavePredecessors :: [RemoteNodeState]
|
|
, leaveDoMigration :: Bool
|
|
}
|
|
| StabiliseRequestPayload
|
|
| PingRequestPayload
|
|
| LoadRequestPayload
|
|
{ loadSegmentUpperBound :: NodeID
|
|
-- ^ upper bound of segment interested in,
|
|
}
|
|
| QueryIDResponsePayload
|
|
{ queryResult :: QueryResponse
|
|
}
|
|
| JoinResponsePayload
|
|
{ joinSuccessors :: [RemoteNodeState]
|
|
, joinPredecessors :: [RemoteNodeState]
|
|
, joinCache :: [RemoteCacheEntry]
|
|
}
|
|
| LeaveResponsePayload
|
|
| StabiliseResponsePayload
|
|
{ stabiliseSuccessors :: [RemoteNodeState]
|
|
, stabilisePredecessors :: [RemoteNodeState]
|
|
}
|
|
| PingResponsePayload
|
|
{ pingNodeStates :: [RemoteNodeState]
|
|
}
|
|
| LoadResponsePayload
|
|
{ loadSum :: Double
|
|
, loadRemainingTarget :: Double
|
|
, loadTotalCapacity :: Double
|
|
, loadSegmentLowerBound :: NodeID
|
|
}
|
|
deriving (Show, Eq)
|
|
|
|
-- | global limit of parts per message used when (de)serialising messages.
|
|
-- Used to limit the impact of DOS attempts with partial messages.
|
|
maximumParts :: Num a => a
|
|
maximumParts = 150
|
|
|
|
-- | 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 RemoteNodeState POSIXTime
|
|
deriving (Show, Eq)
|
|
|
|
instance Ord RemoteCacheEntry where
|
|
(RemoteCacheEntry ns1 _) `compare` (RemoteCacheEntry ns2 _) = nid ns1 `compare` nid ns2
|
|
|
|
toRemoteCacheEntry :: NodeCacheEntry -> RemoteCacheEntry
|
|
toRemoteCacheEntry (CacheEntry _ ns ts) = RemoteCacheEntry ns ts
|
|
|
|
-- | a list of all entries of a 'NodeCache' as 'RemoteCacheEntry', useful for cache transfers
|
|
toRemoteCache :: NodeCache -> [RemoteCacheEntry]
|
|
toRemoteCache cache = toRemoteCacheEntry <$> nodeCacheEntries cache
|
|
|
|
-- | extract the 'NodeState' from a 'RemoteCacheEntry'
|
|
remoteNode :: RemoteCacheEntry -> RemoteNodeState
|
|
remoteNode (RemoteCacheEntry ns _) = ns
|