schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

rename responseTo -> requestID to avoid partial record accessors

Browse source
This commit is contained in:
Trolli Schmittlauch 2020-06-08 20:31:18 +02:00
parent 3892dc91aa
commit 2c827ea326
5 changed files with 21 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
FediChord.asn1
View file

@ -27,7 +27,8 @@ Request ::= SEQUENCE {
-- request and response instead of explicit flag
Response ::= SEQUENCE {
responseTo INTEGER (0..4294967295), -- arbitrarily restricting to an unsigned 32bit integer
-- requestID of the request responding to
requestID INTEGER (0..4294967295), -- arbitrarily restricting to an unsigned 32bit integer
senderID NodeID,
part Partnum,
finalPart BOOLEAN, -- flag indicating this `part` to be the last of this response

8
src/Hash2Pub/ASN1Coding.hs
View file

@ -226,9 +226,9 @@ encodeMessage
<> maybe [] encodePayload requestPayload
<> [End Sequence]
encodeMessage
(Response responseTo senderID part isFinalPart action responsePayload) = [
(Response requestID senderID part isFinalPart action responsePayload) = [
Start Sequence
, IntVal responseTo
, IntVal requestID
, IntVal . getNodeID $ senderID
, IntVal part
, Boolean isFinalPart
@ -277,7 +277,7 @@ parseRequest action = do
pure $ Request requestID sender part isFinalPart action payload
parseResponse :: Integer -> ParseASN1 FediChordMessage
parseResponse responseTo = do
parseResponse requestID = do
senderID <- fromInteger <$> parseInteger :: ParseASN1 NodeID
part <- parseInteger
isFinalPart <- parseBool
@ -290,7 +290,7 @@ parseResponse responseTo = do
Stabilise -> parseStabiliseResponse
Ping -> parsePingResponse
pure $ Response responseTo senderID part isFinalPart action payload
pure $ Response requestID senderID part isFinalPart action payload
parseBool :: ParseASN1 Bool
parseBool = do

15
src/Hash2Pub/DHTProtocol.hs
View file

@ -161,13 +161,14 @@ sendMessageSize = 1200
-- encode the response to a request that just signals successful receipt
ackRequest :: NodeID -> FediChordMessage -> Map.Map Integer BS.ByteString
ackRequest ownID req@Request{} = serialiseMessage sendMessageSize $ Response {
responseTo = requestID req
requestID = requestID req
, senderID = ownID
, part = part req
, isFinalPart = False
, action = action req
, payload = Nothing
}
ackRequest _ _ = Map.empty
-- | Dispatch incoming requests to the dedicated handling and response function, and enqueue
@ -232,7 +233,7 @@ respondQueryID nsSTM msgSet = do
queryResult = queryLocalCache nsSnap cache (fromIntegral $ queryLBestNodes senderPayload') (queryTargetID senderPayload')
}
queryResponseMsg = Response {
responseTo = requestID aRequestPart
requestID = requestID aRequestPart
, senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False
@ -266,7 +267,7 @@ respondLeave nsSTM msgSet = do
. setSuccessors (delete senderID $ requestSuccs <> successors nsSnap) $ nsSnap
-- TODO: handle handover of key data
let leaveResponse = Response {
responseTo = requestID aRequestPart
requestID = requestID aRequestPart
, senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False
@ -287,7 +288,7 @@ respondStabilise nsSTM msgSet = do
, stabilisePredecessors = predecessors nsSnap
}
stabiliseResponse = Response {
responseTo = requestID aRequestPart
requestID = requestID aRequestPart
, senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False
@ -307,7 +308,7 @@ respondPing nsSTM msgSet = do
aRequestPart = Set.elemAt 0 msgSet
responsePayload = PingResponsePayload { pingNodeStates = [ toRemoteNodeState nsSnap ] }
pingResponse = Response {
responseTo = requestID aRequestPart
requestID = requestID aRequestPart
, senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False
@ -343,7 +344,7 @@ respondJoin nsSTM msgSet = do
, joinCache = toRemoteCache cache
}
joinResponse = Response {
responseTo = requestID aRequestPart
requestID = requestID aRequestPart
, senderID = getNid joinedNS
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False
@ -354,7 +355,7 @@ respondJoin nsSTM msgSet = do
pure joinResponse
-- otherwise respond with empty payload
else pure Response {
responseTo = requestID aRequestPart
requestID = requestID aRequestPart
, senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False

8
src/Hash2Pub/ProtocolTypes.hs
View file

@ -30,7 +30,7 @@ data FediChordMessage = Request
, payload :: Maybe ActionPayload
}
| Response
{ responseTo :: Integer
{ requestID :: Integer
, senderID :: NodeID
, part :: Integer
, isFinalPart :: Bool
@ -40,8 +40,12 @@ data FediChordMessage = Request
deriving (Show, Eq)
instance Ord FediChordMessage where
compare a b | requestID a == requestID b = part a `compare` part b
compare a@Request{} b@Request{} | requestID a == requestID b = part a `compare` part b
| otherwise = requestID a `compare` requestID b
compare a@Response{} b@Response{} | requestID a == requestID b = part a `compare` part b
| otherwise = requestID a `compare` requestID b
-- comparing different constructor types always yields "not equal"
compare _ _ = LT
data ActionPayload = QueryIDRequestPayload
{ queryTargetID :: NodeID

2
test/FediChordSpec.hs
View file

@ -201,7 +201,7 @@ spec = do
, payload = undefined
}
responseTemplate = Response {
responseTo = 2342
requestID = 2342
, senderID = nid exampleNodeState
, part = 1
, isFinalPart = True