parse ASN.1 representation of load querying
includes tests contributes to #71
This commit is contained in:
parent
ddea599022
commit
41aaa8ff70
|
@ -184,6 +184,18 @@ encodePayload payload'@PingResponsePayload{} =
|
||||||
Start Sequence
|
Start Sequence
|
||||||
: concatMap encodeNodeState (pingNodeStates payload')
|
: concatMap encodeNodeState (pingNodeStates payload')
|
||||||
<> [End Sequence]
|
<> [End Sequence]
|
||||||
|
encodePayload payload'@LoadRequestPayload{} =
|
||||||
|
[ Start Sequence
|
||||||
|
, IntVal . getNodeID $ loadLowerBound payload'
|
||||||
|
, IntVal . getNodeID $ loadUpperBound payload'
|
||||||
|
, End Sequence
|
||||||
|
]
|
||||||
|
encodePayload payload'@LoadResponsePayload{} =
|
||||||
|
[ Start Sequence
|
||||||
|
, Real $ loadSum payload'
|
||||||
|
, Real $ loadRemainingTarget payload'
|
||||||
|
, End Sequence
|
||||||
|
]
|
||||||
|
|
||||||
encodeNodeState :: NodeState a => a -> [ASN1]
|
encodeNodeState :: NodeState a => a -> [ASN1]
|
||||||
encodeNodeState ns = [
|
encodeNodeState ns = [
|
||||||
|
@ -272,6 +284,7 @@ parseRequest action = do
|
||||||
Leave -> parseLeaveRequest
|
Leave -> parseLeaveRequest
|
||||||
Stabilise -> parseStabiliseRequest
|
Stabilise -> parseStabiliseRequest
|
||||||
Ping -> parsePingRequest
|
Ping -> parsePingRequest
|
||||||
|
QueryLoad -> parseLoadRequestPayload
|
||||||
|
|
||||||
pure $ Request requestID sender part isFinalPart action payload
|
pure $ Request requestID sender part isFinalPart action payload
|
||||||
|
|
||||||
|
@ -288,6 +301,7 @@ parseResponse requestID = do
|
||||||
Leave -> parseLeaveResponse
|
Leave -> parseLeaveResponse
|
||||||
Stabilise -> parseStabiliseResponse
|
Stabilise -> parseStabiliseResponse
|
||||||
Ping -> parsePingResponse
|
Ping -> parsePingResponse
|
||||||
|
QueryLoad -> parseLoadResponsePayload
|
||||||
|
|
||||||
pure $ Response requestID senderID part isFinalPart action payload
|
pure $ Response requestID senderID part isFinalPart action payload
|
||||||
|
|
||||||
|
@ -305,6 +319,13 @@ parseInteger = do
|
||||||
IntVal parsed -> pure parsed
|
IntVal parsed -> pure parsed
|
||||||
x -> throwParseError $ "Expected IntVal but got " <> show x
|
x -> throwParseError $ "Expected IntVal but got " <> show x
|
||||||
|
|
||||||
|
parseReal :: ParseASN1 Double
|
||||||
|
parseReal = do
|
||||||
|
i <- getNext
|
||||||
|
case i of
|
||||||
|
Real parsed -> pure parsed
|
||||||
|
x -> throwParseError $ "Expected Real but got " <> show x
|
||||||
|
|
||||||
parseEnum :: Enum a => ParseASN1 a
|
parseEnum :: Enum a => ParseASN1 a
|
||||||
parseEnum = do
|
parseEnum = do
|
||||||
e <- getNext
|
e <- getNext
|
||||||
|
@ -437,3 +458,22 @@ parsePingResponse = onNextContainer Sequence $ do
|
||||||
pure $ PingResponsePayload {
|
pure $ PingResponsePayload {
|
||||||
pingNodeStates = handledNodes
|
pingNodeStates = handledNodes
|
||||||
}
|
}
|
||||||
|
|
||||||
|
parseLoadRequestPayload :: ParseASN1 ActionPayload
|
||||||
|
parseLoadRequestPayload = onNextContainer Sequence $ do
|
||||||
|
loadLowerBound' <- fromInteger <$> parseInteger
|
||||||
|
loadUpperBound' <- fromInteger <$> parseInteger
|
||||||
|
pure LoadRequestPayload
|
||||||
|
{ loadLowerBound = loadLowerBound'
|
||||||
|
, loadUpperBound = loadUpperBound'
|
||||||
|
}
|
||||||
|
|
||||||
|
parseLoadResponsePayload :: ParseASN1 ActionPayload
|
||||||
|
parseLoadResponsePayload = onNextContainer Sequence $ do
|
||||||
|
loadSum' <- parseReal
|
||||||
|
loadRemainingTarget' <- parseReal
|
||||||
|
pure LoadResponsePayload
|
||||||
|
{ loadSum = loadSum'
|
||||||
|
, loadRemainingTarget = loadRemainingTarget'
|
||||||
|
}
|
||||||
|
|
||||||
|
|
|
@ -16,6 +16,7 @@ data Action = QueryID
|
||||||
| Leave
|
| Leave
|
||||||
| Stabilise
|
| Stabilise
|
||||||
| Ping
|
| Ping
|
||||||
|
| QueryLoad
|
||||||
deriving (Show, Eq, Enum)
|
deriving (Show, Eq, Enum)
|
||||||
|
|
||||||
data FediChordMessage = Request
|
data FediChordMessage = Request
|
||||||
|
@ -73,6 +74,14 @@ data ActionPayload = QueryIDRequestPayload
|
||||||
| PingResponsePayload
|
| PingResponsePayload
|
||||||
{ pingNodeStates :: [RemoteNodeState]
|
{ pingNodeStates :: [RemoteNodeState]
|
||||||
}
|
}
|
||||||
|
| LoadRequestPayload
|
||||||
|
{ loadLowerBound :: NodeID
|
||||||
|
, loadUpperBound :: NodeID
|
||||||
|
}
|
||||||
|
| LoadResponsePayload
|
||||||
|
{ loadSum :: Double
|
||||||
|
, loadRemainingTarget :: Double
|
||||||
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- | global limit of parts per message used when (de)serialising messages.
|
-- | global limit of parts per message used when (de)serialising messages.
|
||||||
|
|
|
@ -221,6 +221,14 @@ spec = do
|
||||||
, exampleNodeState {nid = fromInteger (-5)}
|
, exampleNodeState {nid = fromInteger (-5)}
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
qLoadReqPayload = LoadRequestPayload
|
||||||
|
{ loadLowerBound = fromInteger 12
|
||||||
|
, loadUpperBound = fromInteger 1025
|
||||||
|
}
|
||||||
|
qLoadResPayload = LoadResponsePayload
|
||||||
|
{ loadSum = 3.141
|
||||||
|
, loadRemainingTarget = -1.337
|
||||||
|
}
|
||||||
requestTemplate = Request {
|
requestTemplate = Request {
|
||||||
requestID = 2342
|
requestID = 2342
|
||||||
, sender = exampleNodeState
|
, sender = exampleNodeState
|
||||||
|
@ -259,6 +267,8 @@ spec = do
|
||||||
encodeDecodeAndCheck $ responseWith Leave lResPayload
|
encodeDecodeAndCheck $ responseWith Leave lResPayload
|
||||||
encodeDecodeAndCheck $ responseWith Stabilise stabResPayload
|
encodeDecodeAndCheck $ responseWith Stabilise stabResPayload
|
||||||
encodeDecodeAndCheck $ responseWith Ping pingResPayload
|
encodeDecodeAndCheck $ responseWith Ping pingResPayload
|
||||||
|
encodeDecodeAndCheck $ requestWith QueryLoad qLoadReqPayload
|
||||||
|
encodeDecodeAndCheck $ responseWith QueryLoad qLoadResPayload
|
||||||
it "messages are encoded and decoded to ASN.1 DER properly" $
|
it "messages are encoded and decoded to ASN.1 DER properly" $
|
||||||
deserialiseMessage (fromJust $ Map.lookup 1 (serialiseMessage 652 $ responseWith Ping pingResPayload)) `shouldBe` Right (responseWith Ping pingResPayload)
|
deserialiseMessage (fromJust $ Map.lookup 1 (serialiseMessage 652 $ responseWith Ping pingResPayload)) `shouldBe` Right (responseWith Ping pingResPayload)
|
||||||
it "messages too large for a single packet can (often) be split into multiple parts" $ do
|
it "messages too large for a single packet can (often) be split into multiple parts" $ do
|
||||||
|
|
Loading…
Reference in a new issue