improve encoding documentation and syntax

This commit is contained in:
Trolli Schmittlauch 2020-05-06 02:43:40 +02:00
parent 31b73b7667
commit c9654d66d6

View file

@ -34,6 +34,7 @@ data FediChordMessage =
, sender :: NodeState
, parts :: Integer
, part :: Integer
-- ^ part starts at 0
, action :: Action
, payload :: ActionPayload
}
@ -81,7 +82,9 @@ data ActionPayload =
-- Only some kinds of payloads can be split, and only to a limited number of parts.
-- This function only deals with potentially large payload types and passes the
-- rest as-is.
splitPayload :: Int -> ActionPayload -> [ActionPayload]
splitPayload :: Int -- number of parts to split payload into
-> ActionPayload -- payload to be split
-> [ActionPayload] -- list of smaller payloads
splitPayload numParts pl@LeaveRequestPayload{} = [
LeaveRequestPayload {
leaveSuccessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ leaveSuccessors pl
@ -125,7 +128,10 @@ chunkLength numParts totalSize = ceiling $ (realToFrac totalSize :: Double) / re
-- The number of parts per message is limited to 150 for DOS protection reasons.
-- The returned byte strings might exceed the desired maximum length, as only the payload (and not all of them)
-- can be split into multiple parts.
serialiseMessage :: FediChordMessage -> Int -> [BS.ByteString]
serialiseMessage :: FediChordMessage -- mesage to be serialised in preparation for sending
-> Int -- maximum message size in bytes
-> [BS.ByteString] -- list of ASN.1 DER encoded messages together representing
-- the contents of the input message
serialiseMessage msg maxBytesLength =
splitPayloadUntilSmallEnough 1
where
@ -155,31 +161,33 @@ serialiseMessage msg maxBytesLength =
-- ===== encoding functions =====
-- encode a message 'ActionPayload' according to its type,
-- indicated by the data constructor, as ASN.1
encodePayload :: ActionPayload -> [ASN1]
encodePayload LeaveResponsePayload = [Null]
encodePayload payload@LeaveRequestPayload{} =
encodePayload payload'@LeaveRequestPayload{} =
Start Sequence
: Start Sequence
: (map (IntVal . getNodeID) $ leaveSuccessors payload)
: map (IntVal . getNodeID) (leaveSuccessors payload')
++ [End Sequence
, Start Sequence]
++ (map (IntVal . getNodeID) $ leavePredecessors payload)
++ map (IntVal . getNodeID) (leavePredecessors payload')
++ [End Sequence
, End Sequence]
-- currently StabiliseResponsePayload and LeaveRequestPayload are equal
encodePayload payload@StabiliseResponsePayload{} =
encodePayload payload'@StabiliseResponsePayload{} =
Start Sequence
: Start Sequence
: (map (IntVal . getNodeID) $ stabiliseSuccessors payload)
: map (IntVal . getNodeID) (stabiliseSuccessors payload')
++ [End Sequence
, Start Sequence]
++ (map (IntVal . getNodeID) $ stabilisePredecessors payload)
++ map (IntVal . getNodeID) (stabilisePredecessors payload')
++ [End Sequence
, End Sequence]
encodePayload payload@StabiliseRequestPayload = [Null]
encodePayload payload@QueryIDResponsePayload{} =
encodePayload payload'@StabiliseRequestPayload = [Null]
encodePayload payload'@QueryIDResponsePayload{} =
let
resp = queryResult payload
resp = queryResult payload'
in
Start Sequence
: encodeQueryResult resp
@ -190,33 +198,32 @@ encodePayload payload@QueryIDResponsePayload{} =
: (concatMap encodeCacheEntry . Set.elems $ entrySet)
++ [End Sequence]
++ [End Sequence]
encodePayload payload@QueryIDResponsePayload{} = [
encodePayload payload'@QueryIDRequestPayload{} = [
Start Sequence
, IntVal . getNodeID $ queryTargetID payload
, IntVal $ queryLBestNodes payload
, IntVal . getNodeID $ queryTargetID payload'
, IntVal $ queryLBestNodes payload'
, End Sequence
]
-- | encodes the @JoinResponsePayload@ ASN.1 type
encodePayload payload@JoinResponsePayload{} =
encodePayload payload'@JoinResponsePayload{} =
Start Sequence
: Start Sequence
: (map (IntVal . getNodeID) $ joinSuccessors payload)
: map (IntVal . getNodeID) (joinSuccessors payload')
++ [End Sequence
, Start Sequence]
++ (map (IntVal . getNodeID) $ joinPredecessors payload)
++ map (IntVal . getNodeID) (joinPredecessors payload')
++ [End Sequence
, Start Sequence]
++ (concatMap encodeCacheEntry $ joinCache payload)
++ concatMap encodeCacheEntry (joinCache payload')
++ [End Sequence
, End Sequence]
encodePayload payload@JoinRequestPayload{} = [Null]
encodePayload payload'@JoinRequestPayload{} = [Null]
encodePayload PingRequestPayload{} = [Null]
encodePayload payload@PingResponsePayload{} =
encodePayload payload'@PingResponsePayload{} =
Start Sequence
: (concatMap encodeNodeState $ pingNodeStates payload)
: concatMap encodeNodeState (pingNodeStates payload')
++ [End Sequence]
encodeNodeState :: NodeState -> [ASN1]
encodeNodeState ns = [
Start Sequence