improve encoding documentation and syntax
This commit is contained in:
parent
31b73b7667
commit
c9654d66d6
|
@ -34,6 +34,7 @@ data FediChordMessage =
|
||||||
, sender :: NodeState
|
, sender :: NodeState
|
||||||
, parts :: Integer
|
, parts :: Integer
|
||||||
, part :: Integer
|
, part :: Integer
|
||||||
|
-- ^ part starts at 0
|
||||||
, action :: Action
|
, action :: Action
|
||||||
, payload :: ActionPayload
|
, payload :: ActionPayload
|
||||||
}
|
}
|
||||||
|
@ -81,7 +82,9 @@ data ActionPayload =
|
||||||
-- 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.
|
||||||
-- This function only deals with potentially large payload types and passes the
|
-- This function only deals with potentially large payload types and passes the
|
||||||
-- rest as-is.
|
-- 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{} = [
|
splitPayload numParts pl@LeaveRequestPayload{} = [
|
||||||
LeaveRequestPayload {
|
LeaveRequestPayload {
|
||||||
leaveSuccessors = fromMaybe [] $ headMay . drop thisPart $ listInto numParts $ leaveSuccessors pl
|
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 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)
|
-- 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.
|
-- 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 =
|
serialiseMessage msg maxBytesLength =
|
||||||
splitPayloadUntilSmallEnough 1
|
splitPayloadUntilSmallEnough 1
|
||||||
where
|
where
|
||||||
|
@ -155,31 +161,33 @@ serialiseMessage msg maxBytesLength =
|
||||||
|
|
||||||
-- ===== encoding functions =====
|
-- ===== encoding functions =====
|
||||||
|
|
||||||
|
-- encode a message 'ActionPayload' according to its type,
|
||||||
|
-- indicated by the data constructor, as ASN.1
|
||||||
encodePayload :: ActionPayload -> [ASN1]
|
encodePayload :: ActionPayload -> [ASN1]
|
||||||
encodePayload LeaveResponsePayload = [Null]
|
encodePayload LeaveResponsePayload = [Null]
|
||||||
encodePayload payload@LeaveRequestPayload{} =
|
encodePayload payload'@LeaveRequestPayload{} =
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: Start Sequence
|
: Start Sequence
|
||||||
: (map (IntVal . getNodeID) $ leaveSuccessors payload)
|
: map (IntVal . getNodeID) (leaveSuccessors payload')
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, Start Sequence]
|
, Start Sequence]
|
||||||
++ (map (IntVal . getNodeID) $ leavePredecessors payload)
|
++ map (IntVal . getNodeID) (leavePredecessors payload')
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, End Sequence]
|
, End Sequence]
|
||||||
-- currently StabiliseResponsePayload and LeaveRequestPayload are equal
|
-- currently StabiliseResponsePayload and LeaveRequestPayload are equal
|
||||||
encodePayload payload@StabiliseResponsePayload{} =
|
encodePayload payload'@StabiliseResponsePayload{} =
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: Start Sequence
|
: Start Sequence
|
||||||
: (map (IntVal . getNodeID) $ stabiliseSuccessors payload)
|
: map (IntVal . getNodeID) (stabiliseSuccessors payload')
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, Start Sequence]
|
, Start Sequence]
|
||||||
++ (map (IntVal . getNodeID) $ stabilisePredecessors payload)
|
++ map (IntVal . getNodeID) (stabilisePredecessors payload')
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, End Sequence]
|
, End Sequence]
|
||||||
encodePayload payload@StabiliseRequestPayload = [Null]
|
encodePayload payload'@StabiliseRequestPayload = [Null]
|
||||||
encodePayload payload@QueryIDResponsePayload{} =
|
encodePayload payload'@QueryIDResponsePayload{} =
|
||||||
let
|
let
|
||||||
resp = queryResult payload
|
resp = queryResult payload'
|
||||||
in
|
in
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: encodeQueryResult resp
|
: encodeQueryResult resp
|
||||||
|
@ -190,33 +198,32 @@ encodePayload payload@QueryIDResponsePayload{} =
|
||||||
: (concatMap encodeCacheEntry . Set.elems $ entrySet)
|
: (concatMap encodeCacheEntry . Set.elems $ entrySet)
|
||||||
++ [End Sequence]
|
++ [End Sequence]
|
||||||
++ [End Sequence]
|
++ [End Sequence]
|
||||||
encodePayload payload@QueryIDResponsePayload{} = [
|
encodePayload payload'@QueryIDRequestPayload{} = [
|
||||||
Start Sequence
|
Start Sequence
|
||||||
, IntVal . getNodeID $ queryTargetID payload
|
, IntVal . getNodeID $ queryTargetID payload'
|
||||||
, IntVal $ queryLBestNodes payload
|
, IntVal $ queryLBestNodes payload'
|
||||||
, End Sequence
|
, End Sequence
|
||||||
]
|
]
|
||||||
-- | encodes the @JoinResponsePayload@ ASN.1 type
|
-- | encodes the @JoinResponsePayload@ ASN.1 type
|
||||||
encodePayload payload@JoinResponsePayload{} =
|
encodePayload payload'@JoinResponsePayload{} =
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: Start Sequence
|
: Start Sequence
|
||||||
: (map (IntVal . getNodeID) $ joinSuccessors payload)
|
: map (IntVal . getNodeID) (joinSuccessors payload')
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, Start Sequence]
|
, Start Sequence]
|
||||||
++ (map (IntVal . getNodeID) $ joinPredecessors payload)
|
++ map (IntVal . getNodeID) (joinPredecessors payload')
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, Start Sequence]
|
, Start Sequence]
|
||||||
++ (concatMap encodeCacheEntry $ joinCache payload)
|
++ concatMap encodeCacheEntry (joinCache payload')
|
||||||
++ [End Sequence
|
++ [End Sequence
|
||||||
, End Sequence]
|
, End Sequence]
|
||||||
encodePayload payload@JoinRequestPayload{} = [Null]
|
encodePayload payload'@JoinRequestPayload{} = [Null]
|
||||||
encodePayload PingRequestPayload{} = [Null]
|
encodePayload PingRequestPayload{} = [Null]
|
||||||
encodePayload payload@PingResponsePayload{} =
|
encodePayload payload'@PingResponsePayload{} =
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: (concatMap encodeNodeState $ pingNodeStates payload)
|
: concatMap encodeNodeState (pingNodeStates payload')
|
||||||
++ [End Sequence]
|
++ [End Sequence]
|
||||||
|
|
||||||
|
|
||||||
encodeNodeState :: NodeState -> [ASN1]
|
encodeNodeState :: NodeState -> [ASN1]
|
||||||
encodeNodeState ns = [
|
encodeNodeState ns = [
|
||||||
Start Sequence
|
Start Sequence
|
||||||
|
|
Loading…
Reference in a new issue