parse ASN.1 representation of load querying

includes tests
contributes to #71
This commit is contained in:
Trolli Schmittlauch 2020-09-18 01:33:31 +02:00
parent ddea599022
commit 41aaa8ff70
3 changed files with 59 additions and 0 deletions

View file

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

View file

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

View file

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