forked from schmittlauch/Hash2Pub
define data types for DHT messaging
encoding and parsing functions have been adjusted accordingly
This commit is contained in:
parent
e81a4d23e7
commit
9f16964efc
|
@ -24,6 +24,54 @@ data Action =
|
||||||
| Ping
|
| Ping
|
||||||
deriving (Show, Eq, Enum)
|
deriving (Show, Eq, Enum)
|
||||||
|
|
||||||
|
-- ToDo: probably move this to DHTProtocol as it is high-level
|
||||||
|
|
||||||
|
data FediChordMessage = FediChordMessage {
|
||||||
|
messageType :: MessageType
|
||||||
|
, requestID :: Integer
|
||||||
|
, senderID :: NodeID
|
||||||
|
, parts :: Integer
|
||||||
|
, part :: Integer
|
||||||
|
, action :: Action
|
||||||
|
, payload :: ActionPayload
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
data MessageType = Request | Response deriving (Show, Eq, Enum)
|
||||||
|
|
||||||
|
data ActionPayload =
|
||||||
|
QueryIDRequestPayload {
|
||||||
|
queryTargetID :: NodeID
|
||||||
|
, queryLBestNodes :: Integer
|
||||||
|
}
|
||||||
|
| JoinRequestPayload {
|
||||||
|
joinNodeState :: NodeState
|
||||||
|
}
|
||||||
|
| LeaveRequestPayload {
|
||||||
|
leaveSuccessors :: [NodeID]
|
||||||
|
, leavePredecessors :: [NodeID]
|
||||||
|
}
|
||||||
|
| StabiliseRequestPayload {
|
||||||
|
stabiliseNodeState :: NodeState
|
||||||
|
}
|
||||||
|
| PingRequestPayload
|
||||||
|
| QueryIDResponsePayload {
|
||||||
|
queryResult :: QueryResponse
|
||||||
|
}
|
||||||
|
| JoinResponsePayload {
|
||||||
|
joinSuccessors :: [NodeID]
|
||||||
|
, joinPredecessors :: [NodeID]
|
||||||
|
, joinCache :: [CacheEntry]
|
||||||
|
}
|
||||||
|
| LeaveResponsePayload
|
||||||
|
| StabiliseResponsePayload {
|
||||||
|
stabiliseSuccessors :: [NodeID]
|
||||||
|
, stabilisePredecessors :: [NodeID]
|
||||||
|
}
|
||||||
|
| PingResponsePayload {
|
||||||
|
pingNodeStates :: [NodeState]
|
||||||
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- ToDo: pagination so packets do not exceed maximum size
|
-- ToDo: pagination so packets do not exceed maximum size
|
||||||
-- probably should be taken care of by the callers of this, as the ASN.1
|
-- probably should be taken care of by the callers of this, as the ASN.1
|
||||||
-- encoding functions are layer-4 agnostic
|
-- encoding functions are layer-4 agnostic
|
||||||
|
@ -51,33 +99,45 @@ encodeCacheEntry (NodeEntry _ ns timestamp) =
|
||||||
, End Sequence]
|
, End Sequence]
|
||||||
encodeCacheEntry _ = []
|
encodeCacheEntry _ = []
|
||||||
|
|
||||||
encodeLeaveReceivePayload :: [ASN1]
|
encodeLeaveResponsePayload :: [ASN1]
|
||||||
encodeLeaveReceivePayload = [Null]
|
encodeLeaveResponsePayload = [Null]
|
||||||
|
|
||||||
encodeLeaveSendPayload :: [NodeID] -> [NodeID] -> [ASN1]
|
encodeLeaveRequestPayload :: ActionPayload -> [ASN1]
|
||||||
encodeLeaveSendPayload succ' pred' =
|
encodeLeaveRequestPayload payload@LeaveRequestPayload{} =
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: Start Sequence
|
: Start Sequence
|
||||||
: map (IntVal . getNodeID) succ'
|
: map (IntVal . getNodeID) $ leaveSuccessors payload
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, Start Sequence]
|
, Start Sequence]
|
||||||
++ map (IntVal . getNodeID) pred'
|
++ map (IntVal . getNodeID) $ leavePredecessors payload
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, End Sequence]
|
, End Sequence]
|
||||||
|
|
||||||
-- currently StabiliseReceivePayload and LeaveSendPayload are equal
|
-- currently StabiliseResponsePayload and LeaveRequestPayload are equal
|
||||||
encodeStabiliseReceivePayload :: [NodeID] -> [NodeID] -> [ASN1]
|
encodeStabiliseResponsePayload :: ActionPayload -> [ASN1]
|
||||||
encodeStabiliseReceivePayload = encodeLeaveSendPayload
|
encodeStabiliseResponsePayload payload@StabiliseResponsePayload{} =
|
||||||
|
Start Sequence
|
||||||
|
: Start Sequence
|
||||||
|
: map (IntVal . getNodeID) $ stabiliseSuccessors payload
|
||||||
|
++ [End Sequence
|
||||||
|
, Start Sequence]
|
||||||
|
++ map (IntVal . getNodeID) $ stabilisePredecessors payload
|
||||||
|
++ [End Sequence
|
||||||
|
, End Sequence]
|
||||||
|
|
||||||
encodeStabiliseSendPayload :: NodeState -> [ASN1]
|
encodeStabiliseRequestPayload :: ActionPayload -> [ASN1]
|
||||||
encodeStabiliseSendPayload = encodeNodeState
|
encodeStabiliseRequestPayload payload@StabiliseRequestPayload =
|
||||||
|
encodeNodeState $ stabiliseNodeState payload
|
||||||
|
|
||||||
encodeQueryResult :: QueryResponse -> ASN1
|
encodeQueryResult :: QueryResponse -> ASN1
|
||||||
encodeQueryResult FOUND{} = Enumerated 0
|
encodeQueryResult FOUND{} = Enumerated 0
|
||||||
encodeQueryResult FORWARD{} = Enumerated 1
|
encodeQueryResult FORWARD{} = Enumerated 1
|
||||||
|
|
||||||
encodeQueryIDReceivePayload :: QueryResponse -> [ASN1]
|
encodeQueryIDResponsePayload :: ActionPayload -> [ASN1]
|
||||||
encodeQueryIDReceivePayload resp =
|
encodeQueryIDResponsePayload payload@QueryIDResponsePayload{} =
|
||||||
|
let
|
||||||
|
resp = queryResult payload
|
||||||
|
in
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: encodeQueryResult resp
|
: encodeQueryResult resp
|
||||||
: case resp of
|
: case resp of
|
||||||
|
@ -88,43 +148,53 @@ encodeQueryIDReceivePayload resp =
|
||||||
++ [End Sequence]
|
++ [End Sequence]
|
||||||
++ [End Sequence]
|
++ [End Sequence]
|
||||||
|
|
||||||
encodeQueryIDSendPayload :: NodeID -> Integer -> [ASN1]
|
encodeQueryIDRequestPayload :: ActionPayload -> [ASN1]
|
||||||
encodeQueryIDSendPayload targetID lNodes = [
|
encodeQueryIDRequestPayload payload@QueryIDResponsePayload = [
|
||||||
Start Sequence
|
Start Sequence
|
||||||
, IntVal . getNodeID $ targetID
|
, IntVal . getNodeID $ queryTargetID payload
|
||||||
, IntVal lNodes
|
, IntVal $ queryLBestNodes payload
|
||||||
, End Sequence
|
, End Sequence
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | encodes the @JoinReceivePayload@ ASN.1 type
|
-- | encodes the @JoinResponsePayload@ ASN.1 type
|
||||||
encodeJoinReceivePayload :: [NodeID] -> [NodeID] -> [CacheEntry] -> [ASN1]
|
encodeJoinResponsePayload :: ActionPayload -> [ASN1]
|
||||||
encodeJoinReceivePayload succ' pred' ncache =
|
encodeJoinResponsePayload payload@JoinResponsePayload =
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: Start Sequence
|
: Start Sequence
|
||||||
: map (IntVal . getNodeID) succ'
|
: map (IntVal . getNodeID) $ joinSuccessors payload
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, Start Sequence]
|
, Start Sequence]
|
||||||
++ map (IntVal . getNodeID) pred'
|
++ map (IntVal . getNodeID) $ joinPredecessors payload
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, Start Sequence]
|
, Start Sequence]
|
||||||
++ concatMap encodeCacheEntry ncache
|
++ concatMap encodeCacheEntry $ joinCache payload
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, End Sequence]
|
, End Sequence]
|
||||||
|
|
||||||
encodeJoinSendPayload :: NodeState -> [ASN1]
|
encodeJoinRequestPayload :: ActionPayload -> [ASN1]
|
||||||
encodeJoinSendPayload = encodeNodeState
|
encodeJoinRequestPayload payload@JoinRequestPayload =
|
||||||
|
encodeNodeState $ joinNodeState payload
|
||||||
|
|
||||||
encodePingSendPayload :: [ASN1]
|
encodePingRequestPayload :: [ASN1]
|
||||||
encodePingSendPayload = Null
|
encodePingRequestPayload = Null
|
||||||
|
|
||||||
encodePingReceivePayload :: [NodeState] -> [ASN1]
|
encodePingResponsePayload :: ActionPayload -> [ASN1]
|
||||||
encodePingReceivePayload nss =
|
encodePingResponsePayload payload@PingResponsePayload =
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: concatMap encodeNodeState nss
|
: concatMap encodeNodeState $ pingNodeStates payload
|
||||||
++ [End Sequence]
|
++ [End Sequence]
|
||||||
|
|
||||||
encodeRequest :: Integer -> NodeID -> Integer -> Integer -> Action -> [ASN1] -> [ASN1]
|
-- | Encode a 'FediChordMessage' as ASN.1.
|
||||||
encodeRequest requestID senderID parts part action payload = [
|
-- The 'ActionPayload' needs to be passed separately, already encoded as ASN.1,
|
||||||
|
-- to allow controlling message size by splitting the payload into multiple parts.
|
||||||
|
encodeMessage :: FediChordMessage -- ^ the 'FediChordMessage to be encoded, the
|
||||||
|
-- contained 'payload' is ignored
|
||||||
|
-> [ASN1] -- ^ the ASN.1 encoding of
|
||||||
|
-- the message's 'payload'
|
||||||
|
-> [ASN1]
|
||||||
|
encodeMessage
|
||||||
|
(FediChordMessage Request requestID senderID parts part action _)
|
||||||
|
payload = [
|
||||||
Start Sequence
|
Start Sequence
|
||||||
, Enumerated . fromIntegral . fromEnum $ action
|
, Enumerated . fromIntegral . fromEnum $ action
|
||||||
, IntVal requestID
|
, IntVal requestID
|
||||||
|
@ -132,9 +202,9 @@ encodeRequest requestID senderID parts part action payload = [
|
||||||
, IntVal parts
|
, IntVal parts
|
||||||
, IntVal part ]
|
, IntVal part ]
|
||||||
++ payload
|
++ payload
|
||||||
|
encodeMessage
|
||||||
encodeResponse :: Integer -> NodeID -> Integer -> Integer -> Action -> [ASN1] -> [ASN1]
|
(FediChordMessage Response responseTo senderID parts part action _)
|
||||||
encodeResponse responseTo senderID parts part action payload = [
|
payload = [
|
||||||
Start Sequence
|
Start Sequence
|
||||||
, IntVal responseTo
|
, IntVal responseTo
|
||||||
, IntVal . getNodeID $ senderID
|
, IntVal . getNodeID $ senderID
|
||||||
|
@ -145,7 +215,7 @@ encodeResponse responseTo senderID parts part action payload = [
|
||||||
|
|
||||||
-- ===== parser combinators =====
|
-- ===== parser combinators =====
|
||||||
|
|
||||||
parseMessage :: ParseASN1 () -- todo: change type
|
parseMessage :: ParseASN1 FediChordMessage
|
||||||
parseMessage = do
|
parseMessage = do
|
||||||
-- request and response messages are distiguishable by their structure,
|
-- request and response messages are distiguishable by their structure,
|
||||||
-- see ASN.1 schema
|
-- see ASN.1 schema
|
||||||
|
@ -154,7 +224,7 @@ parseMessage = do
|
||||||
Enumerated a -> parseRequest . toEnum $ a
|
Enumerated a -> parseRequest . toEnum $ a
|
||||||
IntVal i -> parseResponse i
|
IntVal i -> parseResponse i
|
||||||
|
|
||||||
parseRequest :: Action -> ParseASN1 () -- todo: change type
|
parseRequest :: Action -> ParseASN1 FediChordMessage
|
||||||
parseRequest action = do
|
parseRequest action = do
|
||||||
requestID <- parseInteger
|
requestID <- parseInteger
|
||||||
senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID)
|
senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID)
|
||||||
|
@ -170,7 +240,7 @@ parseRequest action = do
|
||||||
|
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
parseResponse :: Integer -> ParseASN1 () -- todo: change type
|
parseResponse :: Integer -> ParseASN1 FediChordMessage
|
||||||
parseResponse responseTo = do
|
parseResponse responseTo = do
|
||||||
senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID)
|
senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID)
|
||||||
parts <- parseInteger
|
parts <- parseInteger
|
||||||
|
|
Loading…
Reference in a new issue