define data types for DHT messaging

encoding and parsing functions have been adjusted accordingly
This commit is contained in:
Trolli Schmittlauch 2020-05-01 00:45:36 +02:00
parent e81a4d23e7
commit 9f16964efc

View file

@ -24,6 +24,54 @@ data Action =
| Ping
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
-- probably should be taken care of by the callers of this, as the ASN.1
-- encoding functions are layer-4 agnostic
@ -51,33 +99,45 @@ encodeCacheEntry (NodeEntry _ ns timestamp) =
, End Sequence]
encodeCacheEntry _ = []
encodeLeaveReceivePayload :: [ASN1]
encodeLeaveReceivePayload = [Null]
encodeLeaveResponsePayload :: [ASN1]
encodeLeaveResponsePayload = [Null]
encodeLeaveSendPayload :: [NodeID] -> [NodeID] -> [ASN1]
encodeLeaveSendPayload succ' pred' =
encodeLeaveRequestPayload :: ActionPayload -> [ASN1]
encodeLeaveRequestPayload payload@LeaveRequestPayload{} =
Start Sequence
: Start Sequence
: map (IntVal . getNodeID) succ'
: map (IntVal . getNodeID) $ leaveSuccessors payload
++ [End Sequence
, Start Sequence]
++ map (IntVal . getNodeID) pred'
++ map (IntVal . getNodeID) $ leavePredecessors payload
++ [End Sequence
, End Sequence]
, End Sequence]
-- currently StabiliseReceivePayload and LeaveSendPayload are equal
encodeStabiliseReceivePayload :: [NodeID] -> [NodeID] -> [ASN1]
encodeStabiliseReceivePayload = encodeLeaveSendPayload
-- currently StabiliseResponsePayload and LeaveRequestPayload are equal
encodeStabiliseResponsePayload :: ActionPayload -> [ASN1]
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]
encodeStabiliseSendPayload = encodeNodeState
encodeStabiliseRequestPayload :: ActionPayload -> [ASN1]
encodeStabiliseRequestPayload payload@StabiliseRequestPayload =
encodeNodeState $ stabiliseNodeState payload
encodeQueryResult :: QueryResponse -> ASN1
encodeQueryResult FOUND{} = Enumerated 0
encodeQueryResult FORWARD{} = Enumerated 1
encodeQueryIDReceivePayload :: QueryResponse -> [ASN1]
encodeQueryIDReceivePayload resp =
encodeQueryIDResponsePayload :: ActionPayload -> [ASN1]
encodeQueryIDResponsePayload payload@QueryIDResponsePayload{} =
let
resp = queryResult payload
in
Start Sequence
: encodeQueryResult resp
: case resp of
@ -88,64 +148,74 @@ encodeQueryIDReceivePayload resp =
++ [End Sequence]
++ [End Sequence]
encodeQueryIDSendPayload :: NodeID -> Integer -> [ASN1]
encodeQueryIDSendPayload targetID lNodes = [
encodeQueryIDRequestPayload :: ActionPayload -> [ASN1]
encodeQueryIDRequestPayload payload@QueryIDResponsePayload = [
Start Sequence
, IntVal . getNodeID $ targetID
, IntVal lNodes
, IntVal . getNodeID $ queryTargetID payload
, IntVal $ queryLBestNodes payload
, End Sequence
]
-- | encodes the @JoinReceivePayload@ ASN.1 type
encodeJoinReceivePayload :: [NodeID] -> [NodeID] -> [CacheEntry] -> [ASN1]
encodeJoinReceivePayload succ' pred' ncache =
-- | encodes the @JoinResponsePayload@ ASN.1 type
encodeJoinResponsePayload :: ActionPayload -> [ASN1]
encodeJoinResponsePayload payload@JoinResponsePayload =
Start Sequence
: Start Sequence
: map (IntVal . getNodeID) succ'
: map (IntVal . getNodeID) $ joinSuccessors payload
++ [End Sequence
, Start Sequence]
++ map (IntVal . getNodeID) pred'
++ map (IntVal . getNodeID) $ joinPredecessors payload
++ [End Sequence
, Start Sequence]
++ concatMap encodeCacheEntry ncache
++ concatMap encodeCacheEntry $ joinCache payload
++ [End Sequence
, End Sequence]
encodeJoinSendPayload :: NodeState -> [ASN1]
encodeJoinSendPayload = encodeNodeState
encodeJoinRequestPayload :: ActionPayload -> [ASN1]
encodeJoinRequestPayload payload@JoinRequestPayload =
encodeNodeState $ joinNodeState payload
encodePingSendPayload :: [ASN1]
encodePingSendPayload = Null
encodePingRequestPayload :: [ASN1]
encodePingRequestPayload = Null
encodePingReceivePayload :: [NodeState] -> [ASN1]
encodePingReceivePayload nss =
encodePingResponsePayload :: ActionPayload -> [ASN1]
encodePingResponsePayload payload@PingResponsePayload =
Start Sequence
: concatMap encodeNodeState nss
: concatMap encodeNodeState $ pingNodeStates payload
++ [End Sequence]
encodeRequest :: Integer -> NodeID -> Integer -> Integer -> Action -> [ASN1] -> [ASN1]
encodeRequest requestID senderID parts part action payload = [
Start Sequence
, Enumerated . fromIntegral . fromEnum $ action
, IntVal requestID
, IntVal . getNodeID $ senderID
, IntVal parts
, IntVal part ]
++ payload
encodeResponse :: Integer -> NodeID -> Integer -> Integer -> Action -> [ASN1] -> [ASN1]
encodeResponse responseTo senderID parts part action payload = [
Start Sequence
, IntVal responseTo
, IntVal . getNodeID $ senderID
, IntVal parts
, IntVal part
, Enumerated . fromIntegral . fromEnum $ action]
++ payload
-- | Encode a 'FediChordMessage' as ASN.1.
-- 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
, Enumerated . fromIntegral . fromEnum $ action
, IntVal requestID
, IntVal . getNodeID $ senderID
, IntVal parts
, IntVal part ]
++ payload
encodeMessage
(FediChordMessage Response responseTo senderID parts part action _)
payload = [
Start Sequence
, IntVal responseTo
, IntVal . getNodeID $ senderID
, IntVal parts
, IntVal part
, Enumerated . fromIntegral . fromEnum $ action]
++ payload
-- ===== parser combinators =====
parseMessage :: ParseASN1 () -- todo: change type
parseMessage :: ParseASN1 FediChordMessage
parseMessage = do
-- request and response messages are distiguishable by their structure,
-- see ASN.1 schema
@ -154,7 +224,7 @@ parseMessage = do
Enumerated a -> parseRequest . toEnum $ a
IntVal i -> parseResponse i
parseRequest :: Action -> ParseASN1 () -- todo: change type
parseRequest :: Action -> ParseASN1 FediChordMessage
parseRequest action = do
requestID <- parseInteger
senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID)
@ -170,7 +240,7 @@ parseRequest action = do
return ()
parseResponse :: Integer -> ParseASN1 () -- todo: change type
parseResponse :: Integer -> ParseASN1 FediChordMessage
parseResponse responseTo = do
senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID)
parts <- parseInteger