diff --git a/Hash2Pub/FediChord.asn1 b/Hash2Pub/FediChord.asn1 index 6b52ad4..97b6242 100644 --- a/Hash2Pub/FediChord.asn1 +++ b/Hash2Pub/FediChord.asn1 @@ -11,7 +11,7 @@ Request ::= SEQUENCE { requestID INTEGER, sender NodeState, 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 { queryIDRequestPayload QueryIDRequestPayload, joinRequestPayload JoinRequestPayload, diff --git a/Hash2Pub/src/Hash2Pub/ASN1Coding.hs b/Hash2Pub/src/Hash2Pub/ASN1Coding.hs index ec6aa46..8446427 100644 --- a/Hash2Pub/src/Hash2Pub/ASN1Coding.hs +++ b/Hash2Pub/src/Hash2Pub/ASN1Coding.hs @@ -20,6 +20,9 @@ import Hash2Pub.FediChord import Hash2Pub.Utils 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 -- individual messages. -- 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 splitPayload numParts pl@LeaveRequestPayload{} = [ LeaveRequestPayload { - leaveSuccessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ leaveSuccessors pl - , leavePredecessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ leavePredecessors pl - } | thisPart <- [0..numParts] ] + leaveSuccessors = atDef [] (listInto numParts $ leaveSuccessors pl) (thisPart-1) + , leavePredecessors = atDef [] (listInto numParts $ leavePredecessors pl) (thisPart-1) + } | thisPart <- [1..numParts] ] splitPayload numParts pl@StabiliseResponsePayload{} = [ StabiliseResponsePayload { - stabiliseSuccessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ stabiliseSuccessors pl - , stabilisePredecessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ stabilisePredecessors pl - } | thisPart <- [0..numParts] ] + stabiliseSuccessors = atDef [] (listInto numParts $ stabiliseSuccessors pl) (thisPart-1) + , stabilisePredecessors = atDef [] (listInto numParts $ stabilisePredecessors pl) (thisPart-1) + } | thisPart <- [1..numParts] ] splitPayload numParts pl@PingResponsePayload{} = [ PingResponsePayload { - pingNodeStates = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ pingNodeStates pl - } | thisPart <- [0..numParts] ] + pingNodeStates = atDef [] (listInto numParts $ pingNodeStates pl) (thisPart-1) + } | thisPart <- [1..numParts] ] splitPayload numParts pl@JoinResponsePayload{} = [ JoinResponsePayload { - joinSuccessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ joinSuccessors pl - , joinPredecessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ joinPredecessors pl - , joinCache = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ joinCache pl - } | thisPart <- [0..numParts] ] + joinSuccessors = atDef [] (listInto numParts $ joinSuccessors pl) $ thisPart-1 + , joinPredecessors = atDef [] (listInto numParts $ joinPredecessors pl) $ thisPart-1 + , joinCache = atDef [] (listInto numParts $ joinCache pl) $ thisPart-1 + } | thisPart <- [1..numParts] ] splitPayload _ pl@(QueryIDResponsePayload FOUND{}) = [pl] splitPayload numParts pl@(QueryIDResponsePayload (FORWARD resSet)) = [ QueryIDResponsePayload { - queryResult = maybe (FORWARD Set.empty) FORWARD $ headMay . drop thisPart $ setInto numParts resSet - } | thisPart <- [0..numParts] ] + queryResult = FORWARD $ atDef Set.empty (setInto numParts resSet) $ thisPart-1 + } | thisPart <- [1..numParts] ] -- pass all other payloads as-is splitPayload _ somePayload = [somePayload] @@ -94,9 +97,9 @@ serialiseMessage maxBytesLength msg = , payload = pl , parts = fromIntegral i }):pls - -- part starts at 0 + -- part starts at 1 payloadParts :: Int -> [(Integer, ActionPayload)] - payloadParts i = zip [0..] (splitPayload i actionPayload) + payloadParts i = zip [1..] (splitPayload i actionPayload) actionPayload = payload msg encodedMsgs i = map (encodeASN1' DER . encodeMessage) $ messageParts i maxMsgLength msgs = maximum $ map BS.length msgs diff --git a/Hash2Pub/test/FediChordSpec.hs b/Hash2Pub/test/FediChordSpec.hs index a3bcd57..7bd5009 100644 --- a/Hash2Pub/test/FediChordSpec.hs +++ b/Hash2Pub/test/FediChordSpec.hs @@ -200,7 +200,7 @@ spec = do requestID = 2342 , sender = exampleNodeState , parts = 1 - , part = 0 + , part = 1 , action = undefined , payload = undefined } @@ -208,7 +208,7 @@ spec = do responseTo = 2342 , senderID = nid exampleNodeState , parts = 1 - , part = 0 + , part = 1 , action = undefined , payload = undefined }