forked from schmittlauch/Hash2Pub
fix off-by-one error in message splitting
This commit is contained in:
parent
0d91452641
commit
ca383420a6
|
@ -11,7 +11,7 @@ Request ::= SEQUENCE {
|
||||||
requestID INTEGER,
|
requestID INTEGER,
|
||||||
sender NodeState,
|
sender NodeState,
|
||||||
parts INTEGER, -- number of message parts
|
parts INTEGER, -- number of message parts
|
||||||
part INTEGER, -- part number of this message
|
part INTEGER, -- part number of this message, starts at 1
|
||||||
actionPayload CHOICE {
|
actionPayload CHOICE {
|
||||||
queryIDRequestPayload QueryIDRequestPayload,
|
queryIDRequestPayload QueryIDRequestPayload,
|
||||||
joinRequestPayload JoinRequestPayload,
|
joinRequestPayload JoinRequestPayload,
|
||||||
|
|
|
@ -20,6 +20,9 @@ import Hash2Pub.FediChord
|
||||||
import Hash2Pub.Utils
|
import Hash2Pub.Utils
|
||||||
import Hash2Pub.DHTProtocol
|
import Hash2Pub.DHTProtocol
|
||||||
|
|
||||||
|
import Debug.Trace
|
||||||
|
|
||||||
|
-- TODO: make this splitting function more intelligent, currently it creates many parts that are smaller than they could be
|
||||||
-- | Try splitting a payload into multiple parts to be able to reduce size of
|
-- | Try splitting a payload into multiple parts to be able to reduce size of
|
||||||
-- individual messages.
|
-- individual messages.
|
||||||
-- Only some kinds of payloads can be split, and only to a limited number of parts.
|
-- Only some kinds of payloads can be split, and only to a limited number of parts.
|
||||||
|
@ -30,29 +33,29 @@ splitPayload :: Int -- number of parts to split payload into
|
||||||
-> [ActionPayload] -- list of smaller payloads
|
-> [ActionPayload] -- list of smaller payloads
|
||||||
splitPayload numParts pl@LeaveRequestPayload{} = [
|
splitPayload numParts pl@LeaveRequestPayload{} = [
|
||||||
LeaveRequestPayload {
|
LeaveRequestPayload {
|
||||||
leaveSuccessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ leaveSuccessors pl
|
leaveSuccessors = atDef [] (listInto numParts $ leaveSuccessors pl) (thisPart-1)
|
||||||
, leavePredecessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ leavePredecessors pl
|
, leavePredecessors = atDef [] (listInto numParts $ leavePredecessors pl) (thisPart-1)
|
||||||
} | thisPart <- [0..numParts] ]
|
} | thisPart <- [1..numParts] ]
|
||||||
splitPayload numParts pl@StabiliseResponsePayload{} = [
|
splitPayload numParts pl@StabiliseResponsePayload{} = [
|
||||||
StabiliseResponsePayload {
|
StabiliseResponsePayload {
|
||||||
stabiliseSuccessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ stabiliseSuccessors pl
|
stabiliseSuccessors = atDef [] (listInto numParts $ stabiliseSuccessors pl) (thisPart-1)
|
||||||
, stabilisePredecessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ stabilisePredecessors pl
|
, stabilisePredecessors = atDef [] (listInto numParts $ stabilisePredecessors pl) (thisPart-1)
|
||||||
} | thisPart <- [0..numParts] ]
|
} | thisPart <- [1..numParts] ]
|
||||||
splitPayload numParts pl@PingResponsePayload{} = [
|
splitPayload numParts pl@PingResponsePayload{} = [
|
||||||
PingResponsePayload {
|
PingResponsePayload {
|
||||||
pingNodeStates = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ pingNodeStates pl
|
pingNodeStates = atDef [] (listInto numParts $ pingNodeStates pl) (thisPart-1)
|
||||||
} | thisPart <- [0..numParts] ]
|
} | thisPart <- [1..numParts] ]
|
||||||
splitPayload numParts pl@JoinResponsePayload{} = [
|
splitPayload numParts pl@JoinResponsePayload{} = [
|
||||||
JoinResponsePayload {
|
JoinResponsePayload {
|
||||||
joinSuccessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ joinSuccessors pl
|
joinSuccessors = atDef [] (listInto numParts $ joinSuccessors pl) $ thisPart-1
|
||||||
, joinPredecessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ joinPredecessors pl
|
, joinPredecessors = atDef [] (listInto numParts $ joinPredecessors pl) $ thisPart-1
|
||||||
, joinCache = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ joinCache pl
|
, joinCache = atDef [] (listInto numParts $ joinCache pl) $ thisPart-1
|
||||||
} | thisPart <- [0..numParts] ]
|
} | thisPart <- [1..numParts] ]
|
||||||
splitPayload _ pl@(QueryIDResponsePayload FOUND{}) = [pl]
|
splitPayload _ pl@(QueryIDResponsePayload FOUND{}) = [pl]
|
||||||
splitPayload numParts pl@(QueryIDResponsePayload (FORWARD resSet)) = [
|
splitPayload numParts pl@(QueryIDResponsePayload (FORWARD resSet)) = [
|
||||||
QueryIDResponsePayload {
|
QueryIDResponsePayload {
|
||||||
queryResult = maybe (FORWARD Set.empty) FORWARD $ headMay . drop thisPart $ setInto numParts resSet
|
queryResult = FORWARD $ atDef Set.empty (setInto numParts resSet) $ thisPart-1
|
||||||
} | thisPart <- [0..numParts] ]
|
} | thisPart <- [1..numParts] ]
|
||||||
-- pass all other payloads as-is
|
-- pass all other payloads as-is
|
||||||
splitPayload _ somePayload = [somePayload]
|
splitPayload _ somePayload = [somePayload]
|
||||||
|
|
||||||
|
@ -94,9 +97,9 @@ serialiseMessage maxBytesLength msg =
|
||||||
, payload = pl
|
, payload = pl
|
||||||
, parts = fromIntegral i
|
, parts = fromIntegral i
|
||||||
}):pls
|
}):pls
|
||||||
-- part starts at 0
|
-- part starts at 1
|
||||||
payloadParts :: Int -> [(Integer, ActionPayload)]
|
payloadParts :: Int -> [(Integer, ActionPayload)]
|
||||||
payloadParts i = zip [0..] (splitPayload i actionPayload)
|
payloadParts i = zip [1..] (splitPayload i actionPayload)
|
||||||
actionPayload = payload msg
|
actionPayload = payload msg
|
||||||
encodedMsgs i = map (encodeASN1' DER . encodeMessage) $ messageParts i
|
encodedMsgs i = map (encodeASN1' DER . encodeMessage) $ messageParts i
|
||||||
maxMsgLength msgs = maximum $ map BS.length msgs
|
maxMsgLength msgs = maximum $ map BS.length msgs
|
||||||
|
|
|
@ -200,7 +200,7 @@ spec = do
|
||||||
requestID = 2342
|
requestID = 2342
|
||||||
, sender = exampleNodeState
|
, sender = exampleNodeState
|
||||||
, parts = 1
|
, parts = 1
|
||||||
, part = 0
|
, part = 1
|
||||||
, action = undefined
|
, action = undefined
|
||||||
, payload = undefined
|
, payload = undefined
|
||||||
}
|
}
|
||||||
|
@ -208,7 +208,7 @@ spec = do
|
||||||
responseTo = 2342
|
responseTo = 2342
|
||||||
, senderID = nid exampleNodeState
|
, senderID = nid exampleNodeState
|
||||||
, parts = 1
|
, parts = 1
|
||||||
, part = 0
|
, part = 1
|
||||||
, action = undefined
|
, action = undefined
|
||||||
, payload = undefined
|
, payload = undefined
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in a new issue