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

fix off-by-one error in message splitting

Browse source
This commit is contained in:
Trolli Schmittlauch 2020-05-11 11:40:50 +02:00
parent 0d91452641
commit ca383420a6
3 changed files with 22 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Hash2Pub/FediChord.asn1
View file

@ -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,

35
Hash2Pub/src/Hash2Pub/ASN1Coding.hs
View file

@ -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

4
Hash2Pub/test/FediChordSpec.hs
View file

@ -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
} }